Merge Multiple Workbooks that have multiple worksh

Question

I keep having this issue of VBA either not having an object for the new sheet I want to merge, or having the subscript out of range issue come up. None of the things I tried ended up working.

Private Sub MergeButton_Click()
Dim filename As Variant
Dim wb As Workbook
Dim s As Sheet1
Dim thisSheet As Sheet1
Dim lastUsedRow As Range
Dim j As Integer


On Error GoTo ErrMsg

Application.ScreenUpdating = False


    Set thisSheet = ThisWorkbook.ActiveSheet
    MsgBox "Reached method"
    'j is for the sheet number which needs to be created in 2,3,5,12,16
    For Each Sheet In ActiveWorkbook.Sheets
    For i = 0 To FilesListBox.ListCount - 1

        filename = FilesListBox.List(i, 0)
        'Open the spreadsheet in ReadOnly mode
        Set wb = Application.Workbooks.Open(filename, ReadOnly:=True)

        'Copy the used range (i.e. cells with data) from the opened spreadsheet
        If FirstRowHeadersCheckBox.Value And i > 0 Then 'Only include headers from the first spreadsheet
            Dim mr As Integer
            mr = wb.ActiveSheet.UsedRange.Rows.Count
            wb.ActiveSheet.UsedRange.Offset(3, 0).Resize(mr - 3).Copy
        Else
            wb.ActiveSheet.UsedRange.Copy
        End If
          'thisSheet = ThisWorkbook.Worksheets(SheetCurr)
        'Paste after the last used cell in the master spreadsheet
        If Application.Version < "12.0" Then 'Excel 2007 introduced more rows
            Set lastUsedRow = thisSheet.Range("A65536").End(xlUp)
        Else
            Set lastUsedRow = thisSheet.Range("A1048576").End(xlUp)
        End If

        'Only offset by 1 if there are current rows with data in them
        If thisSheet.UsedRange.Rows.Count > 1 Or Application.CountA(thisSheet.Rows(1)) Then
            Set lastUsedRow = lastUsedRow.Offset(1, 0)
        End If
        lastUsedRow.PasteSpecial
        Application.CutCopyMode = False

    Next i

This is where I try to add an extra loop that copies the next sheet (which is Sheet12) but it comes up with the Subscript our of range error.

     Sheets("Sheet3").Activate
     Sheet.Copy After:=ThisWorkbook.Sheets
     Next Sheet

It will then move to the next sheet to perform the loop again.

ThisWorkbook.Save
Set wb = Nothing

#If Mac Then
    'Do nothing. Closing workbooks fails on Mac for some reason
#Else
    'Close the workbooks except this one
    Dim file As String
    For i = 0 To FilesListBox.ListCount - 1
        file = FilesListBox.List(i, 0)
        file = Right(file, Len(file) - InStrRev(file, Application.PathSeparator, , 1))
        Workbooks(file).Close SaveChanges:=False
    Next i
#End If

Application.ScreenUpdating = True
Unload Me
ErrMsg:
If Err.Number <> 0 Then
    MsgBox "There was an error. Please try again. [" & Err.Description & "]"
 End If
 End Sub

Any help an this would be great

Answer 1

Your source code is very confusing and I believe you're stumbling because the ActiveWorkbook and ActiveSheet change each time you open a new workbook. It's also not clear why you're copying/merging the data from each worksheet in every opened workbook and then copying Sheet3. You will help yourself by more clearly defining what and where your data is and how you're moving it around.

As an example (that may not solve your problem, because your problem is not clear), look at the code below to see how you can keep the sources and destinations straight within your loops. Modify this example as much as you need in order to match your exact situation.

Sub Merge()
    '--- assumes that each sheet in your destination workbook matches a sheet
    '    in each of the source workbooks, then copies the data from each source
    '    sheet and merges/appends that source data to the bottom of each
    '    destination sheet
    Dim destWB As Workbook
    Dim srcWB As Workbook
    Dim destSH As Worksheet
    Dim srcSH As Worksheet
    Dim srcRange As Range
    Dim i As Long

    Application.ScreenUpdating = False
    Set destWB = ThisWorkbook
    For i = 0 To FileListBox.ListCount - 1
        Set srcWB = Workbooks.Open(CStr(FileListBox(i, 0)), ReadOnly:=True)
        For Each destSH In destWB.Sheets
            Set srcSH = srcWB.Sheets(destSH.Name)  'target the same named worksheet
            lastdestrow = destSH.Range("A").End(xlUp)
            srcSH.UsedRange.Copy destSH.Range(Cells(lastdestrow, 1))
        Next destSH
        srcWB.Close
    Next i
    Application.ScreenUpdating = True
End Sub