Loop to import worksheet from different workbooks inside one folder

[lucas.lobo]

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 Sub

Thanks in advance for any help

[Marc L]

Hi !

Each worksheet is imported, processed and exported to a new folder.

Imported : where ? That needs a clear explanation of each step …

What is your question, what are you expecting for ?

It seems you forgot to follow the Dir VBA help sample, a must read …

[lucas.lobo]

Hi Marc,

Thanks for the reply.

Sorry if it was not clear.

Before running the code, the user must insert into: Sheets("Menu").Cells(18, 11) , the full path to the folder where the .xls files to be imported are located.

My expectation is to import all the .xls files from that given folder. However, I am struggling with that because the code is finding repeatedly and for inifinite times the very same file, while it should process the 'next' file, i.e. a different one.

And thanks for the tip, I will look into the Dir VBA help sample and try to fix this.

[Marc L]

because the code is finding repeatedly and for inifinite times the very same file

As you just forgot before the Loop statement to load the next file in the file variable as you can see in the Dir sample …

[AlphaFrog]

There was a couple of problems.
1.) As Marc suggested, to get the next file name in the loop you have to use myFile = Dir command at the bottom of the loop. This will retrieve the next file in the folder using the original path from earlier myFile = Dir(myPath & myExtension, vbNormal)

2.) A caveat with the Dir function is; to get the next file in the folder, you cannot use the Dir function anywhere else in the loop to do something else. If you do, you lose the ability to get the next file in the original folder. In your case, you also used the Dir function within the loop to test if the new filename already existed. In the code below I use another method (FileSystemObject) to test if the file name already exists.

Try this. Not tested. Very likely there will be an error.

Sub CombineSheets()
    
    Dim myPath             As String
    Dim myFile             As String
    Dim strOutput_Folder   As String
    Dim strOutput_filename As String
    Dim FSO                As Object
    
    Set FSO = CreateObject("Scripting.FileSystemObject")    '<--to test if file exists
    
    Application.ScreenUpdating = False
    
    strOutput_Folder = Sheets("Menu").Cells(19, 11).Value & "\"
    myPath = Sheets("Menu").Cells(18, 11).Value & "\"
    myFile = Dir(myPath & "*.xls*", vbNormal)
    
    Do While myFile <> ""
        
        With Workbooks.Open(myPath & myFile)
            .Sheets(1).Copy Before:=ThisWorkbook.Sheets(1)
            .Close False
        End With
        
        Call Import_Pre_Processing
        Call Fill_Data
        Sheets("tarif_client_COMPLET").Delete
        
        'Save Steps
        With ThisWorkbook.Sheets("Menu")
            .Range("K17").FormulaR1C1 = "=tariffs!R[480]C[-9]"
            strOutput_filename = .Range("K17").Value & ".xls"
        End With
        
        If FSO.FileExists(strOutput_Folder & strOutput_filename) Then    'Test if file exists
            MsgBox strOutput_Folder & strOutput_filename, vbExclamation, "File Already Exists"
        Else
            ThisWorkbook.Sheets("tariffs").Copy    'Copy sheet as new workbook
            ActiveWorkbook.SaveAs Filename:=strOutput_Folder & strOutput_filename
            ActiveWorkbook.Close False
        End If
        
        myFile = Dir    'next file
        
    Loop
    
    Application.ScreenUpdating = True
    
    MsgBox "You can find the files in " & strOutput_Folder, vbInformation, "Combine Sheets Complete"
    
End Sub

[lucas.lobo]

Hi Marc and AlphaFrog,

I just wanted to say thanks! Now the code is working perfectly.

Thanks also for pointing out to what I did wrong - very helpful to avoid the same mistake another time

Regards
Lucas

[AlphaFrog]

You're welcome. Thanks for the feedback.