Look at this video on how to achieve with Power Query which is part of Excel.
Unfortunately im stuck on office 2007 
and no Power Query
Hopefully, someone with some advanced VBA skills will come to your rescue.
Hello Funfex,
See if this at least heads you in the right direction:-
Sub Test()
Dim stgF As String, stgP As String
Dim lr As Long, nr As Long, i As Long
Dim wb As Workbook
Dim ws1 As Worksheet: Set ws1 = ThisWorkbook.Worksheets("Sheet1")
Dim ws2 As Worksheet: Set ws2 = ThisWorkbook.Worksheets("Sheet2")
Dim ws3 As Worksheet: Set ws3 = ThisWorkbook.Worksheets("Sheet3")
Dim sh As Worksheet, cAr As Variant, pAr As Variant
stgP = "C:\Users\YOUR FILE PATH HERE"
stgF = Dir(stgP & "\*.xls*")
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.DisplayAlerts = False
For Each sh In ThisWorkbook.Worksheets
sh.UsedRange.Offset(1).Clear
Next sh
Do While stgF <> vbNullString
Set wb = Workbooks.Open(stgP & "\" & stgF)
cAr = Array(wb.Sheets("Sheet1"), wb.Sheets("Sheet2"), wb.Sheets("Sheet3"))
pAr = Array(ws1, ws2, ws3)
For i = 0 To UBound(cAr)
cAr(i).UsedRange.Offset(1).Copy pAr(i).Range("B" & Rows.Count).End(3)(2)
lr = pAr(i).Cells(Rows.Count, "N").End(xlUp).Row
nr = pAr(i).Cells(Rows.Count, "A").End(xlUp).Row + 1
pAr(i).Range("A" & nr & ":A" & lr) = wb.Name
Next i
wb.Close Save = False
stgF = Dir()
Loop
Application.Calculation = xlCalculationAutomatic
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End SubYou'll need to place your file path in the variable stgP.
I hope that this helps.
Cheerio,
vcoolio.
Don’t have an account yet? Register yourself now and be a part of our community!