Append data from same-named worksheets in multiple excel workbooks to new excel workbook

[PatDools]

Hello - I have multiple worksheets of the same name in multiple workbooks.  For example, each of Workbooks #1, #2, and #3, I have Worksheets named 'Sheet1', 'Sheet2', 'Sheet3'.  Each Worksheet contains the exact same columns across the 3 original Workbooks.

I would like to run a script that cycles through each of the 3 Workbooks and takes 'Sheet1' and appends all rows into a Worksheet called 'Sheet1' in a new Workbook (called 'Workbook 4').  Then, do the same process for 'Sheet2' (into 'Sheet2' of 'Workbook 4'), and the same again for 'Sheet3' (into 'Sheet3' of 'Workbook 4'). 

A couple of points:

1)  The 1st row of all Worksheets is always a Header Row, so it only needs to be brought into each Sheet in 'Workbook 4' once.

2)  The original Workbooks (#1, #2, & #3) and the new Workbook #4 will be in the same folder.

Is there some VBA code I can use to accomplish this?

Thank you!

[#2]

@PatDools 

Try this; please test carefully:

Sub MergeWorkbooks()
    Dim sFolder As String
    Dim sFile As String
    Dim wbT As Workbook
    Dim wsT As Worksheet
    Dim wbS As Workbook
    Dim wsS As Worksheet
    Dim r As Long
    With Application.FileDialog(4) ' msoFileDialogFolderPicker
        If .Show Then
            sFolder = .SelectedItems(1)
        Else
            Beep
            Exit Sub
        End If
    End With
    On Error GoTo ErrHandler
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    If Right(sFolder, 1) <> "\" Then
        sFolder = sFolder & "\"
    End If
    sFile = Dir(sFolder & "*.xls*")
    Set wbT = Workbooks.Open(sFolder & sFile)
    sFile = Dir
    Do While sFile <> ""
        Set wbS = Workbooks.Open(sFolder & sFile)
        For Each wsS In wbS.Worksheets
            Set wsT = wbT.Worksheets(wsS.Name)
            r = wsT.Cells.Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row = 1
            wsS.UsedRange.Offset(1).Copy Destination:=wsT.Range("A" & r)
            Application.CutCopyMode = False
        Next wsS
        wbS.Close SaveChanges:=False
        sFile = Dir
    Loop
    wbT.SaveAs Filename:=sFolder & "New Workbook.xlsx", FileFormat:=xlOpenXMLWorkbook
    ' Optional: close the new workbook
    wbT.Close SaveChanges:=False
ExitHandler:
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    Exit Sub
ErrHandler:
    MsgBox Err.Description, vbExclamation
    Resume ExitHandler
End Sub

[#3]

@Hans Vogelaar 

Hi Hans - Thank you so much for the code above. I'm getting the following error: Method 'Range' of object '_Worksheet' failed

I've tried launching the code from both a new Workbook in the same directory (and even tried naming all the Worksheets the same as they are named in the existing Workbooks), as well as launching from an existing Workbook, and I get the error either way.  I do see that it opens the 1st and 2nd Workbooks in the folder (there are 4 total), once I pick the folder from the Dialogue Box that your code launches, but then the above error appears.  I'm a bit of a rookie with VBA, and I'm not sure how to troubleshoot this error - although I do see that both the 'sFile' and 'sFolder' variables that I put a Watch on are empty at the time the error message is launched.  Please let me know what might be happening with this error message.  Thanks again!

[#4]

@PatDools 

Do all workbooks in the folder that you select have exactly the same number worksheets, with the same names?

[#5]

@Hans Vogelaar 

Hi Hans - yes, all workbooks in the directory have exactly the same number worksheets, with the same names and there are no hidden worksheets.  For starters, should I be running this code from a separate Workbook, or should I be running the code from one of the 'source' Workbooks in the directory?  Also, the code opens the first 2 of the 4 Workbooks in the directory before it errors out.  I just recreated the 3rd and 4th Workbooks, just to see if there was any corruption, but this is not the case - still seeing the error.  I'm including a screenshot of the Worksheet names so you can see they are the same.  What else might be happening here? Thank you!

[#6]

@PatDools 

The code was intended to be run from a workbook outside the folder. It will create the destination workbook at the end of the macro, so there shouldn't be a destination workbook in the folder, only source workbooks.

[#7]

@Hans Vogelaar 

I ran the code from a Workbook in a different directory from the source Workbooks and got the same error (at the same point after the first 2 Workbooks are opened by the script).  I put a Watch on the variables you defined and none of them are populated with any values:

Also, I looked at the length of the folder/sub-folder hierarchy, and it is only 85 characters long, so that shouldn't be an issue.  Where else can I look for issues that may be causing this error?

Thank you!

[#8]

@PatDools You have to look at the Watch window while the code is paused - click Debug in the error message window.

[#9]

@Hans Vogelaar 

Hi Hans - thank you for the tip on pausing the Code.  So I can run this script 100% successfully when there is only one file in the Source directory - it creates the new Workbook and writes each tab out perfectly.  The Method 'range' of object '_Worksheet' failed error only occurs when there is more than one Workbook in the source directory.  And it doesn't matter which source Workbook it is, as long as it is the only Workbook in the source directory, your code executes perfectly. Does that provide a better clue as to why I'm getting this error message?  Also, how do I tell which Worksheet is erroring out in the Watch Window while debugging?

[#10 · Accepted solution]

@PatDools 

Aargh - you were right all the time. My code contains a stupid typo - my sincere apologies!

The line

            r = wsT.Cells.Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row = 1

should be

            r = wsT.Cells.Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row - 1

with Row - 1 instead of Row = 1.

[#11]

@Hans Vogelaar 

Hi Hans - that was it!  Thank you for reviewing the code and catching that - greatly appreciated!  This code is doing exactly what I need it to do.  Thanks again!