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
 

Some videos you may like

Excel Facts

Quick Sum
Select a range of cells. The total appears in bottom right of Excel screen. Right-click total to add Max, Min, Count, Average.

Watch MrExcel Video

Forum statistics

Threads
1,122,370
Messages
5,595,770
Members
414,017
Latest member
surajks

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
Top