Hi everyone,
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!R[480]C[-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 SubThanks in advance for any help 