Sub Összevon()
Dim WS As Worksheet, WBSrc As Workbook, WBDest As Workbook
Dim FN As String, Folder As String

With Application.FileDialog(msoFileDialogFolderPicker)
.Title = "Melyik mappában vannak a munkafüzetek?"
.AllowMultiSelect = False
.Show
Folder = .SelectedItems(1) & ""
End With

Set WBDest = Workbooks.Add
FN = Dir(Folder & "*.xls", vbNormal)
While Not FN = ""
Set WBSrc = Workbooks.Open(Folder & FN)
Set WS = WBSrc.Worksheets(1)
WS.Name = Left(Replace(LCase(WBSrc.Name), ".xls", ""), 30)
WS.Copy WBDest.Worksheets(1)
WBSrc.Close SaveChanges:=False
FN = Dir()
Wend
End Sub

Arról neked kell gondoskodnod, hogy ne legyen közöttük két egyforma nevű fájl (pl. "valami.xls" és "valami.xlsx"), és tényleg mindegyik munkafüzetben csak 1 munkalap legyen.