Sub LoopAllExcelFilesInFolder()
Dim wb As Workbook
Dim myPath As String
Dim myFile As String
Dim myExtension As String
Dim FldrPicker As FileDialog
Dim i As Integer
Dim WS_Count As Integer
Set FldrPicker = Application.FileDialog(msoFileDialogFolderPicker)
With FldrPicker
.Title = "Select A Target Folder"
.AllowMultiSelect = False
If .Show <> -1 Then GoTo NextCode
myPath = .SelectedItems(1) & "\"
End With
myExtension = "*.xls*"
myFile = Dir(myPath & myExtension)
Do While myFile <> ""
'Set variable equal to opened workbook
Set wb = Workbooks.Open(Filename:=myPath & myFile)
WS_Count = ActiveWorkbook.Worksheets.Count
For i = 4 To WS_Count
ActiveWorkbook.Sheets(i).Select
With ActiveWorkbook.Sheets(i)
Set RngCol = .Range("A1", .Cells(Rows.Count, 1).End(xlUp))
End With
LastRow = RngCol.Rows.Count
Range("L1:L" & LastRow).Value = ActiveWorkbook.Name
Next i
wb.Close SaveChanges:=True
myFile = Dir
End Sub