VBA - Copy data ranges from multiple worksheets and sequentially paste into a summary tab

Hi All,
I am new on VBA and all I'm trying to do is copying ranges of data from multiple sheets and paste them sequentially into a summary sheet within a single workbook
The code seems to work well, but it is also importing additional and unnecessary data from the worksheets. The ranges may vary each time the data is extracted.
Code used:

Sheets("Summary").Activate

For Each ws In Worksheets
If ws.Name = "ME5A_List" Then
ws.Range("T2:T65000").Copy
ActiveSheet.Paste Range("A2").End(xlUp).Offset(1, 0)
ws.Range("B2:C65000").Copy
ActiveSheet.Paste Range("E2").End(xlUp).Offset(1, 0)
ws.Range("G2:H65000").Copy
ActiveSheet.Paste Range("G2").End(xlUp).Offset(1, 0)
ws.Range("D2:D65000").Copy
ActiveSheet.Paste Range("S2").End(xlUp).Offset(1, 0)
ws.Range("I2:J65000").Copy
ActiveSheet.Paste Range("J2").End(xlUp).Offset(1, 0)
End If
Next ws

For Each ws In Worksheets
If ws.Name = "CC Data" Then
ws.Range("Q2:Q65000").Copy
ActiveSheet.Range("A65536").End(xlUp).Offset(1, 1).Select
ActiveSheet.Paste
ws.Range("Q2:Q65000").Copy
ActiveSheet.Range("A65536").End(xlUp).Offset(1, 1).Select
ActiveSheet.Paste
ws.Range("B2:C65000").Copy
ActiveSheet.Range("A65536").End(xlUp).Offset(1, 4).Select
ActiveSheet.Paste
ws.Range("G2:H65000").Copy
ActiveSheet.Range("A65536").End(xlUp).Offset(1, 6).Select
ActiveSheet.Paste
ws.Range("I2:J65000").Copy
ActiveSheet.Range("A65536").End(xlUp).Offset(1, 9).Select
ActiveSheet.Paste
ws.Range("D2:D65000").Copy
ActiveSheet.Range("A65536").End(xlUp).Offset(1, 18).Select
ActiveSheet.Paste

End If
Next ws

For Each ws In Worksheets
If ws.Name = "IWBK_Data" Then
ws.Range("A2:A65000").Copy
ActiveSheet.Range("B65536").End(xlUp).Offset(1, 1).Select
ActiveSheet.Paste
ws.Range("O2:O65000").Copy
ActiveSheet.Range("B65536").End(xlUp).Offset(1, 2).Select
ActiveSheet.Paste
ws.Range("H2:I65000").Copy
ActiveSheet.Range("B65536").End(xlUp).Offset(1, 8).Select
ActiveSheet.Paste
ws.Range("J2:L65000").Copy
ActiveSheet.Range("B65536").End(xlUp).Offset(1, 11).Select
ActiveSheet.Paste
ws.Range("N2:N65000").Copy
ActiveSheet.Range("B65536").End(xlUp).Offset(1, 15).Select
ActiveSheet.Paste
ws.Range("T2:T65000").Copy
ActiveSheet.Range("B65536").End(xlUp).Offset(1, 16).Select
ActiveSheet.Paste
ws.Range("W2:W65000").Copy
ActiveSheet.Range("B65536").End(xlUp).Offset(1, 10).Select
ActiveSheet.Paste
ws.Range("AB2:AE65000").Copy
ActiveSheet.Range("B65536").End(xlUp).Offset(1, 3).Select
ActiveSheet.Paste
ws.Range("W2:X65000").Copy
ActiveSheet.Range("B65536").End(xlUp).Offset(1, 10).Select
ActiveSheet.Paste
End If
Next ws
Application.ScreenUpdating = True

Ditto Post#2.

Does this help?

Please Login or Register  to view this content.

Hi John,
This is brilliant. Works perfectly.
Cheers

Glad to hear that.