Este código va en un módulo
Sub UnirFiles()
Dim Hoja As Object
Application.DisplayAlerts = False
A = ActiveWorkbook.Name
R = ActiveWorkbook.Path
ChDir R & "\"
archi = Dir("*.xls*")
Do While archi <> A
Workbooks.Open archi
B = ActiveWorkbook.Name
For Each Hoja In ActiveWorkbook.Sheets
Hoja.Copy After:=Workbooks(A).Sheets(Workbooks(A).Sheets.Count)
Next
Workbooks(B).Close False
archi = Dir()
Loop
End Sub