Macro to copy data from multiple worksheets and paste into a single worksheet (within same workbook)

[Kevin Hyskell]

I'm working on a workbook to collect several individual worksheets worth of data into two main worksheets. The data is always changing and the amount of populated rows changes as well. What I need:

Delete all rows under row 5 (starting at row 6) in worksheet "Active - TOTAL"
Delete all rows under row 5 (starting at row 6) in worksheet "Complete - TOTAL"

Copy all rows under row 5 (starting at row 6) in worksheet "Active - KH"
Paste into next available row in worksheet "Active - TOTAL"

Copy all rows under row 5 (starting at row 6) in worksheet "Active - BB"
Paste into next available row in worksheet "Active - TOTAL"

Copy all rows under row 5 (starting at row 6) in worksheet "Complete - KH"
Paste into next available row in worksheet "Complete - TOTAL"

Copy all rows under row 5 (starting at row 6) in worksheet "Complete - BB"
Paste into next available row in worksheet "Complete - TOTAL"

In summary, the idea is to have a main worksheet that collects several other worksheet's data. It's all of the same categories of stuff, but there are several contributors. So, the main sheet needs to be refreshed from time to time. It would be nice (but not required) if at the completion of the copy/paste activities the Active - TOTAL worksheet and Complete - TOTAL worksheets could be sorted. Column B is a date, sorting with the latest dates on bottom. But that's a "nice to have" not a "must have"

Please help me!!!

Thank you in advance!

 

[hennahairgel]

Try these two loops, and repeat/adapt as required:

Sub DeleteRows()
    If Worksheets("Active - TOTAL").Cells.CurrentRegion.Rows.Count > 5 Then
        Worksheets("Active - TOTAL").Rows("5:" & Worksheets("Active - TOTAL").Cells.CurrentRegion.Rows.Count).Delete
    End If
End Sub
Sub CopyRows()
    For i = 6 To Worksheets("Active - KH").Cells.CurrentRegion.Rows.Count
        Worksheets("Active - KH").Rows(i).Copy
        Worksheets("Active - TOTAL").Cells(Worksheets("Active - TOTAL").Cells.CurrentRegion.Rows.Count + 1, 1).Select
        Worksheets("Active - TOTAL").Paste
    Next i
End Sub