Sub mergeBooks()
Dim newBook As String
Dim thePath As String
Dim theFile As String
Dim theBook As String
Workbooks.Add
newBook = ActiveWorkbook.Name
thePath = InputBox("Enter source path", "Source Folder", ActiveWorkbook.Path)
If thePath <> "" Then
' Set the file specification to match the names of the files to merge
theFile = Dir(thePath & "\*.xls*")
While theFile <> ""
Workbooks.Open thePath & "\" & theFile
theBook = ActiveWorkbook.Name
ActiveSheet.Copy after:=Workbooks(newBook).Sheets(Workbooks(newBook).Sheets.Count)
Workbooks(theBook).Close False
theFile = Dir
Wend
End If
End Sub