Combining multiple files to workbook from folder, including subfolders

Hello,

I'm fairly new to Excel when it comes to VBA programming and I need bit of help with some code.
I have code that combines all excel files from folder into one workbook. Each file to it's own sheet in workbook.

Folder where I have files is D:\Test\ (+subfolders D:\Test\1\, D:\Test\2\ etc.. )

Code works fine to all files what are in D:\Test\, but how can I get it, so that it also searches files from subfolders in directory D:\Test\

Many thanks in advance

Here's the code:

Sub HaeData()
Path = "D:\Test\"
Filename = Dir(Path & "*.xls")
Do While Filename <> ""
Workbooks.Open Filename:=Path & Filename, ReadOnly:=True
For Each Sheet In ActiveWorkbook.Sheets
Sheet.Copy After:=ThisWorkbook.Sheets(1)
Next Sheet
Workbooks(Filename).Close
Filename = Dir()
Loop
End Sub

Hi
this nice add-in allows you to add sub-folders

Hello Punssiliini,

Welcome to the Forum!

This version of your macro will allow you to select how many Subfolders from the parent folder you want to search.

Sub CombineFiles(ByVal Path As String, Optional FolderDepth As Long)

    Dim FileCnt     As Long
    Dim Filename    As String
    Dim Sheet       As Object
    Dim Subfolder   As Variant
    Dim Subfolders  As New Collection
    
        On Error GoTo FolderError
        
        Path = IIf(Right(Path, 1) <> "\", Path & "\", Path)
        
        Filename = Dir(Path & "*.xls*")
        
        Do While Filename <> ""
            Workbooks.Open Filename:=Path & Filename, ReadOnly:=True
                For Each Sheet In ActiveWorkbook.Sheets
                    Sheet.Copy After:=ThisWorkbook.Sheets(1)
                Next Sheet
            Workbooks(Filename).Close
            Filename = Dir()
        Loop
        
        Subfolder = Dir(Path, vbDirectory)
        
        MsgBox Path & vbCrLf & "File Count = " & FileCnt
        
        Do While Subfolder <> ""
            If Subfolder <> "." And Subfolder <> ".." Then
                If (GetAttr(Path & Subfolder) And vbDirectory) = vbDirectory Then
                    Subfolders.Add Path & Subfolder
                End If
            End If
            
            Subfolder = Dir()
        Loop
        
        If FolderDepth <> 0 Then
            For Each Subfolder In Subfolders
                Call TestA(Subfolder, FolderDepth - 1)
            Next Subfolder
        End If
        
FolderError:
        If Err Then
            MsgBox "Run-time error '" & Err & "':" & vbCrLf _
                & Err.Description & vbCrLf & vbCrLf _
                & "Folder: " & Path & vbCrLf _
                & "Subfolder: " & Subfolder
        End If
        
End Sub

Using the Macro
Here are a few examples of how to set how deep you want to search.

' To Search the Folder but no Subfolders.
Call CombineFiles("D:\Test", 0)

' To Search search the first level of Subfolders.
Call CombineFiles("D:\Test", 1)

' To Search  All Subfolders.
Call CombineFiles("D:\Test", -1)