Copy/Paste rows to matching named sheet - vba

Question

I have a worksheet "List" which has rows of data that I need to copy to other worksheets. In column "J" of "List", there is a name (Matthew, Mark, Linda, etc.) that designates who's data that row is.
Each of those names (22 in all) has a matching spreadsheet with the same name. I want all rows that say "Linda" in column "J" to paste to worksheet "Linda", all rows with "Matthew" to paste to worksheet "Matthew", etc.
I have some code below, which mostly works, but I'd have to rewrite it for all 22 names/sheets.
Is there a way to loop through all the sheets, pasting the rows with matching names? Also, the code below works really slowly, and I'm using data sets with anywhere from 200 to 60,000 rows that need sorted and pasted, which means that if its slow on a small data set like the one I'm currently working on, and only for one sheet, it's going to be glacially slow for the big data sets.
Sub CopyMatch()
Dim c As Range
Dim j As Integer
Dim Source As Worksheet
Dim Target As Worksheet
Set Source = Worksheets("List")
Set Target = Worksheets("Linda")
j = 4 ' Start copying to row 1 in target sheet
For Each c In Source.Range("J4:J1000") ' Do 1000 rows
If c = "Linda" Then
Source.Rows(c.Row).Copy Target.Rows(j)
j = j + 1
End If
Next c
End Sub

Answer 1

Unless you've turned calculation off somewhere we can't see here, then every time you copy a row, Excel is recalculating - even if your sheets contain no formulas.
If you're not doing so already, simply putting:
application.calculation=xlcalculationmanual
before you start your loop and:
application.calculation=xlcalculationautomatic
after exiting the loop will massively speed up your loop. For extra swank, you can use a variable to store the calculation setting before you turn it off and restore that setting at the end, e.g.
dim lCalc as long
lCalc = application.calculation
application.calculation = xlcalculationmanual
for ... next goes here
application.calculation = lCalc
Also consider other settings, e.g.: application.screenupdating=False|True.
Sort the data by the name you're selecting on, then by any other sorts you want. That way you can skip through any size sheet in 22 steps (since you say you have 22 names).
How you copy the data depends on preference and how much data there is. Copying one row at a time is economical on memory and pretty much guaranteed to work, but is slower. Or you can identify the top and bottom rows of each person's data and copy the whole block as a single range, at the risk of exceeding the memory available on large blocks in large sheets.
Assuming the value in your name column, for the range you're checking, is always one of the 22 names, then if you've sorted first by that column you can use the value in that column to determine the destination, e.g.:
dim sTarget as string
dim rng as range
sTarget = ""
For Each c In Source.Range("J4:J1000") ' Do 1000 rows
if c <> "" then ' skip empty rows
if c <> sTarget then ' new name block
sTarget = c
Set Target = Worksheets(c)
set rng = Target.cells(Target.rows.count, 10).end(xlup) ' 10="J"
j = rng.row + 1 ' first row below last name pasted
end if
Source.Rows(c.Row).Copy Target.Rows(j)
j = j + 1
end if
Next
This is economical of memory because you're going row by row, but still reasonably fast because you're only recalculating Target and resetting j when the name changes.

Answer 2

you could use:
Dictionary object to quickly build the list of unique names out of column J names
AutoFilter() method of Range object for filtering on each name:
as follows
Option Explicit
Sub CopyMatch()
Dim c As Range, namesRng As Range
Dim name As Variant
With Worksheets("List") '<--| reference "List" worskheet
Set namesRng = .Range("J4", .Cells(.Rows.count, "J").End(xlUp)) '<--| set the range of "names" in column "J" starting from row 4 down to last not empty row
End With
With CreateObject("Scripting.Dictionary") '<--| instance a 'Dictionary' object
For Each c In namesRng.SpecialCells(xlCellTypeConstants, xlTextValues) '<--| loop through "names" range cells with text content only
.item(c.Value) = c.Value '<--| build the unique list of names using dictionary key
Next
Set namesRng = namesRng.Resize(namesRng.Rows.count + 1).Offset(-1) '<--| resize the range of "names" to have a "header" cell (not a name to filter on) in the first row
For Each name In .Keys '<--| loop through dictionary keys, i.e. the unique names list
FilterNameAndCopyToWorksheet namesRng, name '<--| filter on current name and copy to corresponding worksheet
Next
End With '<--| release the 'Dictionary' object
End Sub
Sub FilterNameAndCopyToWorksheet(rangeToFilter As Range, nameToFilter As Variant)
Dim destsht As Worksheet
Set destsht = Worksheets(nameToFilter) '<--| set the worksheet object corresponding to passed name
With rangeToFilter
.AutoFilter Field:=1, Criteria1:=nameToFilter
Intersect(.Parent.UsedRange, .Resize(.Rows.count - 1).Offset(1).SpecialCells(xlCellTypeVisible).EntireRow).Copy destsht.Cells(destsht.Rows.count, "J").End(xlUp)
.Parent.AutoFilterMode = False
End With
End Sub