Append 2 or more workbooks with multiple sheets into a single workbook with the same number of sheets

vbakillsnuts

New Member
Joined
Jul 17, 2012
Messages
1
Hi everybody,
I have 6 excel workbooks each with 193 sheets. Format of all the workbooks is same with the same sheet names. I want to append the data of all the 5 workbooks below first workbook just like sheet1 of workbook1 would have the original data of sheet1 of workbook1 then in the very next empty available row paste the data of sheet1 of workbook2 then sheet1 of workbook3 and so on till sheet1 of workbook6, same for the sheet2 , sheet3....................sheet193.
I wrote the code it is working but it does not paste by maintaining the sequence (Problem is, it sometimes paste the sheet3 of workbook2 into the sheet1 of workbook1 but by desire it should paste the sheet1 of workbook2 into the sheet1 of workbook1)
All six Workbook names are:
HYD15.xls
HYD16.xls
HYD17.xls
HYD18.xls
HYD19.xls
HYD20.xls

I am appending HYD16.xls and HYD17.xls manually into HYD15.xls Kindly help me in debugging the code and to use nested for loop which will run 6 times and append all the sheets.
Code:
Sub append_test()
    
    For Index = 1 To 193
    
    Windows("HYD16.xls").Activate
    Worksheets(ActiveSheet.Index).Activate
    lastCol = ActiveSheet.Range("a6").End(xlToRight).Column
    lastRow = ActiveSheet.Cells(65536, lastCol).End(xlUp).Row
    ActiveSheet.Range("a6:" & _
    ActiveSheet.Cells(lastRow, lastCol).Address).Select
    Selection.Copy
    Windows("HYD15.xls").Activate
    Worksheets(ActiveSheet.Index).Activate
    NextRow = Range("A65536").End(xlUp).Row + 1
    Cells(NextRow, 1).Select
    ActiveSheet.Paste
    Worksheets(ActiveSheet.Index + 1).Activate
    
    Next Index
    For Index = 1 To 193
    
    Windows("HYD17.xls").Activate
    Worksheets(ActiveSheet.Index).Activate
    lastCol = ActiveSheet.Range("a6").End(xlToRight).Column
    lastRow = ActiveSheet.Cells(65536, lastCol).End(xlUp).Row
    ActiveSheet.Range("a6:" & _
    ActiveSheet.Cells(lastRow, lastCol).Address).Select
    Selection.Copy
    Windows("HYD15.xls").Activate
    Worksheets(ActiveSheet.Index).Activate
    NextRow = Range("A65536").End(xlUp).Row + 1
    Cells(NextRow, 1).Select
    ActiveSheet.Paste
    Worksheets(ActiveSheet.Index + 1).Activate
    
    Next Index
End Sub
 

Excel Facts

Ambidextrous Undo
Undo last command with Ctrl+Z or Alt+Backspace. If you use the Undo icon in the QAT, open the drop-down arrow to undo up to 100 steps.

Forum statistics

Threads
1,223,981
Messages
6,175,768
Members
452,668
Latest member
mrider123

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top