Объединить файлы в один лист с проблемой имен файлов

Question

У меня небольшая проблема при объединении всех моих файлов в один лист. По какой-то причине, только первый лист с именем файла вверху копируется правильно, на каждом другом скопированном разделе пропускается первая строка, где я вставил имя файла.

Мне интересно, есть ли у него делать с тем, как я вставил имя файла, но

любая помощь будет принята с благодарностью

'PLACES ALL FILES IN FOLDER INTO ONE COMBINED FILE
Filename = Dir(Path & "*.xls")
Do While Filename <> ""
Workbooks.Open Filename:=Path & Filename, ReadOnly:=True
For Each Sheet In ActiveWorkbook.Sheets

Rows(1).Insert Shift:=xlDown, _
CopyOrigin:=xlFormatFromLeftOrAbove 'or xlFormatFromRightOrBelow
[A1].Formula = "=MID(CELL(""filename""),SEARCH(""["",CELL(""filename""))+1, SEARCH(""]"",CELL(""filename""))-SEARCH(""["",CELL(""filename""))-1)"
[A1].Cells(1).Select
[A1].Cells.Copy
[A1].Cells.PasteSpecial xlPasteValues
[A1].Cells(1).Select
Sheet.Copy Before:=wbk.Sheets(1)
Next Sheet
Workbooks(Filename).Close savechanges:=False
Filename = Dir()
Loop


'COMBINES WORKSHEETS INTO ONE COMBINED WORKSHEET
On Error Resume Next
Sheets(1).Select
Worksheets.Add
Sheets(1).Name = "Combined Totals"
Sheets(2).Activate
Range("A1").EntireRow.Select
Selection.Copy Destination:=Sheets(1).Range("A1")
For J = 2 To Sheets.Count
Sheets(J).Activate
Range("A1").Select
Selection.CurrentRegion.Select
Selection.Offset(1, 0).Resize(Selection.Rows.Count - 1).Select
Selection.Copy Destination:=Sheets(1).Range("A65536").End(xlUp).Offset(2)

Next