Sub Tamarbal()
Dim z As Long, e As Long, d As Long
Dim f As String
Application.ScreenUpdating = False
Application.DisplayAlerts = False
d = 2
Sheets("Sheet1").Select
Cells(1, 1) = "=cell(""filename"")"
Cells(1, 2) = "=left(A1,find(""["",A1)-1)"
Cells(2, 1).Select
f = Dir(Cells(1, 2) & "*.xls")
Do While Len(f) > 0
ActiveCell.Formula = f
ActiveCell.Offset(1, 0).Select
f = Dir()
Loop
z = Cells(Rows.Count, 1).End(xlUp).Row
For e = 2 To z
d = Sheets("sheet1").Range("C65536").End(xlUp).Row + 2
Cells(d, 2) = Cells(e, 1)
If Cells(e, 1) <> ActiveWorkbook.Name Then
Workbooks.Open Filename:=Cells(1, 2) & Cells(e, 1)
Worksheets("Sheet1").UsedRange.Copy
ActiveWorkbook.Close False
Cells(d, 3).PasteSpecial
End If
Next e
Application.ScreenUpdating = True
Application.DisplayAlerts = True
MsgBox "collating is complete."
End Sub