Within a loop, need to copy all rows from one sheet to another upon matching criteria

[ripvanbrown]

Using Excel 2003 in XP...I have a database worksheet ("DATA") that I want to copy certain rows of data to multiple worksheets within the same workbook ("KING", "PIERCE", etc.) if it matches the County (e.g. King, Pierce, etc.) of the same worksheet name. Worksheet DATA has 3 header rows and data is in columns A:J but the rows will vary from day to day. Wanting to do the following: for the first row of data in DATA that contains the County (column B in DATA) of the corresponding spreadsheet (e.g. KING), I want to copy everything in that row from DATA, paste in the corresponding spreadsheet, and then continue to the next row in DATA.

I had planned on doing it long-hand as below and write a separate section for each County Spreadsheet (4 of them), but the code is not selecting just a single row in DATA but the entire sheet prior to copying and pasting. At a minimum, I think I just need this line of code below - Range("A" & Row & ":J" & Column).Select - corrected because it is selecting the entire worksheet from A4:J258 - not just all of row 4 (or A4:J4) which is what I need - and then I can just copy and paste the code for the remaining 3 counties. There might also be something wrong in Set OC = ws1.Cells(King.Row, Group.Column) too?

However, if there is an easier/faster code to just go through the DATA sheet once (instead of 4 times) and have it copy a row to the corresponding County sheet and paste/append to that sheet, that would be greatly appreciated.

First time user so please pardon any forum violations and let me know what I need to change.

Thanks!

' Copy County specific data to County spreadsheets
    Sheets("Data").Select
    Range("B4").Select
         
    Dim ws1 As Worksheet, ws2 As Worksheet, ws3 As Worksheet, ws4 As Worksheet, ws5 As Worksheet
    Dim Group As Range, King As Range
    Dim OC As Range, DC As Range, LR As Integer
    ' OC = origination cells, DC = destination cells
    ' LR = abbreviation for Last Row to identify the Last Row that contains data in WS1
    Set ws1 = Sheets("Data")
    Set ws2 = Sheets("King")
    Set ws3 = Sheets("Pierce")
    Set ws4 = Sheets("Snohomish")
    Set ws5 = Sheets("Thurston")
    ' Find the last row in the Data worksheet
    LR = ActiveSheet.UsedRange.Rows.Count
'
    For Each Group In ws1.Range("A4:J" & LR)
        Set DC = ws2.Range("A4")
        For Each King In ws1.Range("A4:J" & LR)
            Set OC = ws1.Cells(King.Row, Group.Column)
            If Not IsEmpty(OC) Then
                Range("A" & Row & ":J" & Column).Select
                Selection.Copy
                Sheets("King").Select
                Range("A" & Row & ":J" & Column).Select
                ActiveSheet.Paste
                DC.Value = OC.Value
                Set DC = OC.Offset(1)
            End If
        Next
    Next