PDA

View Full Version : [SOLVED] Copying multiple sheets with varying numbers of rows to one sheet.



Tony9463
07-15-2016, 02:18 PM
I am trying to copy daily sheets to one monthly consolidation. I have recorded a macro but the problem is that each day has a different number af transactions. After copying the macro for the first month, each subsequent month I run the macro on - having different numbers of transactions than the original macro - either overwrites data or leaves large numbers of blank cells. I have a macro to eliminate the blank cells but I need to tweak the macro to not go to a specific cell number but to the first available blank cell before copying. Also, I need it to copy the full range which may be different each time.
I know this is probably a loop but I'm not sure how to proceed.
A copy is attached:
Thanx in advance...

Sub consolidation()
'
' consolidation Macro
'


'
Selection.End(xlDown).Select
Range("A4251").Select
Sheets("Sheet2").Select
Range("A1:CD4408").Select
Selection.Copy
Sheets("Sheet1").Select
ActiveSheet.Paste
Rows("4251:4251").Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlUp
Selection.End(xlDown).Select
Range("A8658").Select
Sheets("Sheet3").Select
Range("A1:CD3620").Select
Selection.Copy
Sheets("Sheet1").Select
ActiveSheet.Paste
Rows("8658:8658").Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlUp
Selection.End(xlDown).Select
Range("A12277").Select
Sheets("Sheet4").Select
Range("A1:CD3957").Select
Selection.Copy
Sheets("Sheet1").Select
ActiveSheet.Paste
Rows("12277:12277").Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlUp
Selection.End(xlDown).Select
Range("A16233").Select
Sheets("Sheet5").Select
Range("A1:CD5306").Select
Selection.Copy
Sheets("Sheet1").Select
ActiveSheet.Paste
Rows("16233:16233").Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlUp
Selection.End(xlDown).Select
Range("A21538").Select
Sheets("Sheet6").Select
Range("A1:CD4818").Select
Selection.Copy
Sheets("Sheet1").Select
ActiveSheet.Paste
Rows("21538:21538").Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlUp
Selection.End(xlDown).Select
Range("A26355").Select
Sheets("Sheet7").Select
Range("A1:CD4849").Select
Selection.Copy
Sheets("Sheet1").Select
ActiveSheet.Paste
Rows("26355:26355").Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlUp
Selection.End(xlDown).Select
Range("A31203").Select
Sheets("Sheet8").Select
Range("A1:CD4446").Select
Selection.Copy
Sheets("Sheet1").Select
ActiveSheet.Paste
Rows("31203:31203").Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlUp
Selection.End(xlDown).Select
Range("A35648").Select
Sheets("Sheet9").Select
Range("A1:CD4362").Select
Selection.Copy
ActiveWindow.ScrollWorkbookTabs Position:=xlFirst
Sheets("Sheet1").Select
ActiveSheet.Paste
Rows("35648:35648").Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlUp
Selection.End(xlDown).Select
Range("A40009").Select
ActiveWindow.ScrollWorkbookTabs Position:=xlLast
Sheets("Sheet10").Select
Range("A1:CD3662").Select
Selection.Copy
ActiveWindow.ScrollWorkbookTabs Position:=xlFirst
Sheets("Sheet1").Select
ActiveSheet.Paste
Rows("40009:40009").Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlUp
Selection.End(xlDown).Select
Range("A43670").Select
ActiveWindow.ScrollWorkbookTabs Position:=xlLast
Sheets("Sheet11").Select
Range("A1:CD3446").Select
Selection.Copy
ActiveWindow.ScrollWorkbookTabs Position:=xlFirst
Sheets("Sheet1").Select
ActiveSheet.Paste
Rows("43670:43670").Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlUp
Selection.End(xlDown).Select
Range("A47115").Select
ActiveWindow.ScrollWorkbookTabs Position:=xlLast
Sheets("Sheet12").Select
Range("A1:CD4378").Select
Selection.Copy
ActiveWindow.ScrollWorkbookTabs Position:=xlFirst
Sheets("Sheet1").Select
ActiveSheet.Paste
Rows("47115:47115").Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlUp
Selection.End(xlDown).Select
Range("A51492").Select
ActiveWindow.ScrollWorkbookTabs Position:=xlLast
Sheets("Sheet13").Select
Range("A1:CD4564").Select
Selection.Copy
ActiveWindow.ScrollWorkbookTabs Position:=xlFirst
Sheets("Sheet1").Select
ActiveSheet.Paste
Rows("51492:51492").Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlUp
Selection.End(xlDown).Select
Range("A56055").Select
ActiveWindow.ScrollWorkbookTabs Position:=xlLast
Sheets("Sheet14").Select
Range("A1:CD4475").Select
Selection.Copy
ActiveWindow.ScrollWorkbookTabs Position:=xlFirst
Sheets("Sheet1").Select
ActiveSheet.Paste
Rows("56055:56055").Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlUp
Selection.End(xlDown).Select
Range("A60529").Select
ActiveWindow.ScrollWorkbookTabs Position:=xlLast
Sheets("Sheet15").Select
Range("A1:CD4873").Select
Selection.Copy
ActiveWindow.ScrollWorkbookTabs Position:=xlFirst
Sheets("Sheet1").Select
ActiveSheet.Paste
Rows("60529:60529").Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlUp
Selection.End(xlDown).Select
ActiveWindow.SmallScroll Down:=0

mdmackillop
07-16-2016, 05:37 AM
Please post a sample workbook showing your layout and desired result

Tony9463
07-16-2016, 12:05 PM
I don't see a way to upload or even copy my sample workbook for you to view.
Is there a way to do that that I can't see?
Thank you

mdmackillop
07-16-2016, 12:09 PM
Go Advanced/Manage Attachments

Tony9463
07-16-2016, 12:56 PM
16630
My sample was too large to upload so I separated it into sheets. This is the only one small enough to upload.
You can copy this to several different sheets to get an idea of what I need.
I want to copy sheet2 to the bottom of sheet1 then copy sheet3 to the bottom of sheet1 then sheet4 etc. etc.
Thanx

mdmackillop
07-16-2016, 03:04 PM
Sub Test()
For i = 2 To Sheets.Count
Set Tgt = Sheets(1).Cells(Rows.Count, 1).End(xlUp)(2)
Sheets(i).Cells(1, 1).CurrentRegion.Offset(1).Copy Tgt
Next i
End Sub

Tony9463
07-16-2016, 04:52 PM
16631
That is elegant in its simplicity... Awesome!
However, One minor issue. Each subsequent page that is copied starts on the line that represents whatever page number it is.
For instance, Sheet3 starts on line 3 (after stripping the row headers). Sheet12 starts on line 12. I don't see why that is happening.
Thanx for all your help. This is waaay simpler then the way I was trying to do it...

mdmackillop
07-16-2016, 11:30 PM
Apologies for the typo; Offset(1) instead of (i)


Sub Test()
For i = 2 To Sheets.Count
Set Tgt = Sheets(1).Cells(Rows.Count, 1).End(xlUp)(2)
Sheets(i).Cells(1, 1).CurrentRegion.Offset(1).Copy Tgt
Next i
End Sub

Tony9463
07-17-2016, 06:47 AM
:bow:Thanks a lot.
That saved me hours of work... sometimes that 'i' is hard to see...