Appen 2 or more workbooks with multiple sheets into a single workbook

**vbakillsnuts** · 07-17-2012, 12:10 PM

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.

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

**dangelor** · 07-21-2012, 12:33 AM

Not tested...

Option Explicit
Sub append_test()
    Dim x                As Integer
    Dim iIndex           As Integer
    Dim lastCol          As Integer
    Dim lastRow          As Long
    Dim nextRow          As Long
    Dim wbSource         As Workbook
    Dim wbMaster         As Workbook

    Set wbMaster = Workbooks("HYD15.XLS")
    For x = 16 To 20
        Set wbSource = Workbooks("HYD" & x & ".XLS")
        For iIndex = 1 To 193
            With wbSource.Worksheets(iIndex)
                lastCol = .Cells(6, 1).End(xlToRight).Column
                lastRow = .Cells(.Rows.Count, lastCol).End(xlUp).Row
                nextRow = wbMaster.Worksheets(iIndex).Cells(Rows.Count, 1).End(xlUp).Row + 1
                .Range(.Cells(6, 1), .Cells(lastRow, lastCol)).Copy wbMaster.Cells(nextRow, 1)
            End With
        Next iIndex
    Next x
End Sub