PDA

View Full Version : Solved: Copy Paste Loop Multiple Sheets



SDave
12-02-2009, 02:04 PM
Evening all,

Would anyone happen to have a copy paste macro which loops through multiple worksheets within a workbook?!

I have 5 worksheets which I need to copy data from, before pasting it into a worksheet entitled Summary.

The range will always start from C10 in each worksheet however the last data row in column V will always be variable.

Ideally I'd like the macro to copy data from sheet1 and paste it into the Summary worksheet in say A2, then loop through to sheet2 copy the data and find the next empty row in the Summary sheet and paste the copied data, and so on and so forth.

Any help would be much appreciated.

Thanks in advance.

GTO
12-02-2009, 02:35 PM
Greetings,

Presuming all the sheets are in the same wb:

Option Explicit

Sub exa()
Dim wks As Worksheet

For Each wks In ThisWorkbook.Worksheets
If Not wks.Name = "Summary" Then
wks.Range("C10:C" & wks.Cells(Rows.Count, "C").End(xlUp).Row).Copy _
Destination:=Worksheets("Summary").Cells(Rows.Count, "A").End(xlUp).Offset(1)
End If
Next
End Sub


Hope that helps,

Mark

SDave
12-02-2009, 03:12 PM
Thanks Mark, much appreciated.

There are an addittional 3 worksheets that I won't to avoid copying data from, how would I go about excluding them?!

I've tried adding an additional line for each worksheet under
If Not wks.Name = "Summary" Then however I keep on receiving an error after the End If statement.

stanleydgrom
12-02-2009, 03:12 PM
SDave,

If your sheets are named "Sheet1", "Sheet2", "Sheet3", "Sheet4", and "Sheet5", then:


Please TEST this FIRST in a COPY of your workbook (always make a backup copy before trying new code, you never know what you might lose).

Adding the Macro
1. Copy the below macro, by highlighting the macro code and pressing the keys CTRL + C
2. Open your workbook
3. Press the keys ALT + F11 to open the Visual Basic Editor
4. Press the keys ALT + I to activate the Insert menu
5. Press M to insert a Standard Module
6. Paste the code by pressing the keys CTRL + V
7. Press the keys ALT + Q to exit the Editor, and return to Excel
8. To run the macro from Excel, open the workbook, and press ALT + F8 to display the Run Macro Dialog. Double Click the macro's name to Run it.





Sub CopySheets()
' stanleydgrom, 12/02/2009
Dim MySheets As Variant, LR As Long, NR As Long, a As Long
MySheets = Array("Sheet1", "Sheet2", "Sheet3", "Sheet4", "Sheet5")
Application.ScreenUpdating = False
NR = 2
For a = LBound(MySheets) To UBound(MySheets)
With Sheets(MySheets(a))
LR = .Cells(Rows.Count, "V").End(xlUp).Row
.Range("C10:V" & LR).Copy Sheets("Summary").Range("A" & NR)
End With
NR = NR + LR - 10 + 1
Next a
Sheets("Summary").Select
Application.ScreenUpdating = True
End Sub




Then run the "CopySheets" macro,

GTO
12-02-2009, 03:32 PM
Hi SDave,

If you only have specific sheets to copy, listing them as shown by Stanley would be the way. If you are wanting to rule out several, but allow others (including added), you could do that like:

Option Explicit

Sub exa()
Dim wks As Worksheet

For Each wks In ThisWorkbook.Worksheets
If Not wks.Name = "Summary" _
And Not wks.Name = "My OtherSheet" _
And Not wks.Name = "My OtherOther Sheet" Then
wks.Range("C10:C" & wks.Cells(Rows.Count, "C").End(xlUp).Row).Copy _
Destination:=Worksheets("Summary").Cells(Rows.Count, "A").End(xlUp).Offset(1)
End If
Next
End Sub


Hope that helps,

Mark

SDave
12-02-2009, 03:46 PM
Thanks Mark, that's exactly what I was after.

Thank you for all your help, it's very much appreciated.