Copy Rows to a certain Column

[Jessica553]

Hello,
I am trying to tell VBA to copy all the rows that contain the name 'Chris' to a sheet called 'Chris' and then Rob, Andrew etc.
But I want it to just copy from Column A to K. At the moment it's working but with the entire row. Is there a way to change this to just go up to column K?

Sub CopyRow2()
'Declare variables
Dim sheetNo1 As Worksheet
Dim sheetNo2 As Worksheet
Dim sheetNo3 As Worksheet
Dim sheetNo4 As Worksheet
Dim sheetNo5 As Worksheet
Dim sheetNo6 As Worksheet
Dim FinalRow As Long
Dim Cell As Range
'Set variables
Set sheetNo1 = Sheets("DataDump")
Set sheetNo2 = Sheets("Chris")
Set sheetNo3 = Sheets("Rob")
Set sheetNo4 = Sheets("Andrew")
Set sheetNo5 = Sheets("Charlie")
Set sheetNo6 = Sheets("Terry")
'Type a command to select the entire row
Selection.EntireRow.Select
' Define destination sheets to move row
FinalRow1 = sheetNo1.Range("A" & sheetNo1.Rows.Count).End(xlUp).Row
FinalRow2 = sheetNo2.Range("A" & sheetNo2.Rows.Count).End(xlUp).Row
FinalRow3 = sheetNo3.Range("A" & sheetNo3.Rows.Count).End(xlUp).Row
FinalRow4 = sheetNo4.Range("A" & sheetNo4.Rows.Count).End(xlUp).Row
FinalRow5 = sheetNo5.Range("A" & sheetNo5.Rows.Count).End(xlUp).Row
FinalRow5 = sheetNo5.Range("A" & sheetNo5.Rows.Count).End(xlUp).Row
With sheetNo1
'Apply loop for column J until last cell with value
For Each Cell In .Range("J1:J" & .Cells(.Rows.Count, "J").End(xlUp).Row)
'Apply condition to match the "Chris" value
If Cell.Value = "Chris" Then
'Command to Copy and move to a destination Sheet "Chris"
.Rows(Cell.Row).Copy Destination:=sheetNo2.Rows(FinalRow2 + 1)
FinalRow2 = FinalRow2 + 1
'Apply condition to match the "Rob" value
ElseIf Cell.Value = "Rob" Then
'Command to Copy and move to a destination Sheet "Rob"
.Rows(Cell.Row).Copy Destination:=sheetNo3.Rows(FinalRow3 + 1)
FinalRow3 = FinalRow3 + 1
'Apply condition to match the "Andrew" value
ElseIf Cell.Value = "Andrew" Then
'Command to Copy and move to a destination Sheet "Andrew"
.Rows(Cell.Row).Copy Destination:=sheetNo4.Rows(FinalRow4 + 1)
FinalRow4 = FinalRow4 + 1
'Apply condition to match the "Charlie" value
ElseIf Cell.Value = "Charlie" Then
'Command to Copy and move to a destination Sheet "Charlie"
.Rows(Cell.Row).Copy Destination:=sheetNo5.Rows(FinalRow5 + 1)
FinalRow5 = FinalRow5 + 1
'Apply condition to match the "Terry" value
ElseIf Cell.Value = "Terry" Then
'Command to Copy and move to a destination Sheet "Terry"
.Rows(Cell.Row).Copy Destination:=sheetNo6.Rows(FinalRow6 + 1)
FinalRow6 = FinalRow6 + 1
End If
Next Cell
End With
End Sub

 

[kevin9999]

Hello. I am trying to do the same thing. Only difference is I have 50+ sheets (1 for each state and some more for countries). Is there a way to maybe loop through until all data is copied to corresponding sheets? I attached pictures.

Yes, it's possible, but please start a new thread and include sample data (not images) using the XL2BB Tool and a clear description of what goes where. It seems that @Jessica553 has lost interest in this thread.