I hope someone will be able to help me with my issue.
First, I would like to provide a little background. The goal of my code is to import each first worksheet from all workbooks inside a folder. Each worksheet is imported, processed and exported to a new folder, this is done to each file, but not at once. In order to do that, I am using a loop. I am not that much experienced with VBA, and I builded up the code below by googling, checking different threads, etc.
My issue: the code is always processing only one file from the folder (infinite times) and never catching the others. Since we will be working with hundreds and maybe even thousands of files, I cannot rename the files to be imported, thereby their names do not follow any pattern, which is why the code should go through all ".xls" files located in a specific folder.
Sub CombineSheets() Application.DisplayAlerts = False Application.ScreenUpdating = False Dim sPath As String Dim sFname As String Dim wBk As Workbook Dim wSht As Variant Dim stPath As String Dim myPath As String Dim myExtension As String Dim NewBook As Workbook Dim Input_Folder As Range Dim Output_Folder As Range Set Input_Folder = Sheets("Menu").Cells(18, 11) Set Output_Folder = Sheets("Menu").Cells(19, 11) Application.EnableEvents = False Application.ScreenUpdating = False myPath = Input_Folder & "\" myExtension = "*.xls*" myFile = Dir(myPath & myExtension, vbNormal) ChDir myPath sFname = Dir(sPath & "*.xls*", vbNormal) wSht = InputBox("Enter a worksheet name to copy") Do While myFile <> "" ChDir myPath Set wBk = Workbooks.Open(myFile) Windows(myFile).Activate Sheets(wSht).Copy Before:=ThisWorkbook.Sheets(1) wBk.Close False Call Import_Pre_Processing Call Fill_Data Sheets("tarif_client_COMPLET").Delete 'Save Steps Sheets("Menu").Select ActiveCell.FormulaR1C1 = "=tariffs!RC[-9]" Range("K17").Select Selection.Copy Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Application.CutCopyMode = False Dim Output_filename As Range Set Output_filename = ThisWorkbook.Sheets("Menu").Cells(17, 11) Set NewBook = Workbooks.Add ThisWorkbook.Sheets("tariffs").Copy Before:=NewBook.Sheets(1) If Dir(Output_Folder & "\" & Output_filename & ".xls") <> "" Then MsgBox "File " & Output_Folder & "\" & Output_filename & ".xls" & " already exists" Else NewBook.SaveAs fileName:=Output_Folder & "\" & Output_filename & ".xls" End If Application.ActiveWorkbook.Close False Loop Application.EnableEvents = True Application.ScreenUpdating = True MsgBox "You can find the files in " & Output_Folder End Sub
Thanks in advance for any help