Try:
Sub blah()
On Error GoTo errhanldler
Application.ScreenUpdating = False
With Sheets("Names")
Set rngListOfNames = .Range(.Range("A1"), .Range("A1").End(xlDown))
Set rngListOfNames = Intersect(rngListOfNames, rngListOfNames.Offset(1))
Set rngCriteria = .UsedRange.Offset(, .UsedRange.Columns.Count + 1).Resize(2, 1)
rngCriteria.Cells(1).Value = "Name"
End With
Set SourceSheets = Sheets(Array("Data1", "Data2", "Data3")) 'adjust this line if necessary.
Set DestnSheets = Sheets(Array("PASTEData1", "PASTEData2", "PASTEData3")) 'adjust this line if necessary.
For Each cll In rngListOfNames.Cells
rngCriteria.Cells(2).Value = cll.Value
For i = 1 To SourceSheets.Count
DestnSheets(i).Range("A1").CurrentRegion.Clear
SourceSheets(i).Range("A1").CurrentRegion.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=rngCriteria, CopyToRange:=DestnSheets(i).Range("A1"), Unique:=False
Next i
DestnSheets.Copy
With ActiveWorkbook
Application.DisplayAlerts = False 'omit this line if you want to be asked about overwriting an existing file.
.SaveAs Filename:=ThisWorkbook.Path & Application.PathSeparator & cll.Value & ".xlsx", FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
Application.DisplayAlerts = True
.Close
End With
Next cll
For Each sht In DestnSheets
sht.UsedRange.Clear
Next sht
rngCriteria.Clear
errhanldler:
Application.ScreenUpdating = True
End Sub