Try thiis

With ActiveSheet
RowCount = 2
Do While .Range("I" & RowCount) < ""
Select Case .Range("I" & RowCount)

Case "AA", "AB", "XY"
DestSht = Sheets("TS")

Case "AC", "DF", "SS"
DestSht = Sheets("CS")

Case "XX"
DestSht = Sheets("XX")
End Select

LastRow = DestSht.Range("A" & Rows.Count).End(xlUp).Row
Newrow = LastRow + 1
.Rows(RowCount).Copy _
Destination:=DestSht.Rows(Newrow)

RowCount = RowCount + 1
Loop

End With


"Ron" wrote:

I have a sheet with 14 columns of data. Up to 3000 rows, counting a header row.
Column I has a key that I look at to determine which other worksheet to copy
the data to.
For instance, rows with AA, AB, and XY (in column I)I need to copy to a
Sheet named TS.
Rows with AC, DF, SS I need to copy to a Sheet named CS.
And Rows with XX I need to copy to a Sheet named XX.
Of course, it has to copy to the next blank row on each sheet, so all of the
AA's, AB's and XY's are on sheet TS.
Etc.