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

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