Sub LoopAllExcelFilesInFolder() 'PURPOSE: To loop through all Excel files in a user specified folder and perform a set task on them 'SOURCE: www.TheSpreadsheetGuru.com Dim wb As Workbook Dim myPath As String Dim myFile As String Dim myExtension As String Dim FldrPicker As FileDialog Dim lRow As Long Dim ws2 As Worksheet Dim y As Workbook 'Optimize Macro Speed Application.ScreenUpdating = False Application.EnableEvents = False Application.Calculation = xlCalculationManual 'Retrieve Target Folder Path From User Set FldrPicker = Application.FileDialog(msoFileDialogFolderPicker) With FldrPicker .Title = "C:\Users\CONNELLP\Desktop\Claire Macro\Copy and Paste Disputes\Report Sheet\" .AllowMultiSelect = False If .Show <> -1 Then GoTo NextCode myPath = .SelectedItems(1) & "\" End With 'In Case of Cancel NextCode: myPath = myPath If myPath = "" Then GoTo ResetSettings 'Target File Extension (must include wildcard "*") myExtension = "*.xls*" 'Target Path with Ending Extention myFile = Dir(myPath & myExtension) Set y = Workbooks.Open("C:\Users\CONNELLP\Desktop\Claire Macro\Copy and Paste Disputes\Report Sheet") Set ws2 = y.Sheets("Disputes") 'Loop through each Excel file in folder Do While myFile <> "" 'Set variable equal to opened workbook Set wb = Workbooks.Open(Filename:=myPath & myFile) 'Copy data on "SearchCaseResults" sheet to "Disputes" Sheet in other workbook With wb.Sheets("SearchCaseResults") lRow = .Range("A" & Rows.Count).End(xlUp).Row .Range("A2:M" & lRow).Copy ws2.Range("A" & Rows.Count).End(xlUp)(2) End With wb.Close SaveChanges:=True 'Get next file name myFile = Dir Loop 'Message Box when tasks are completed MsgBox "Task Complete!" ResetSettings: 'Reset Macro Optimization Settings Application.EnableEvents = True Application.Calculation = xlCalculationAutomatic Application.ScreenUpdating = True End Sub