[VBA] Loop through files in folder which contain only excel files with same format, then copy its content to master list.

ExtractExcelContents.bas

Public Sub main()
    Dim xDir As String
    Workbooks("combined_list.xlsm").Activate
    xDir = Range("root_url").Value
    
    Call ExtractExcelContents(xDir, True)
End Sub

Private Sub ExtractExcelContents(ByVal xFolderName As String, ByVal xIsSubfolders As Boolean)
    Dim xFileSystemObject As Object, xFolder As Object, xSubFolder As Object
    Dim xFile As Object, rowIndex, seqNum As Long
    Dim masterWS As Worksheet, slaveWS As Worksheet
    Dim totalFiles As Long
    
    Set xFileSystemObject = CreateObject("Scripting.FileSystemObject")
    Set xFolder = xFileSystemObject.GetFolder(xFolderName)
    rowIndex = Application.ActiveSheet.Range("A1048576").End(xlUp).Row + 1
    
    Set masterWS = Workbooks("combined_list.xlsm").ActiveSheet
    'Debug.Print masterWS.Name
    
    totalFiles = CountFilesInFolder(xFolder.Path)
    'Debug.Print totalFiles
    
    seqNum = 1
    For Each xFile In xFolder.Files
        '--- open file
        'Debug.Print xFile.Path
        Workbooks.Open xFile.Path
        
        '--- set slaveWS & activate
        Set slaveWS = ActiveWorkbook.ActiveSheet
        slaveWS.Activate
        
        '--- select all range
        slaveWS.Range("A1").Select
        slaveWS.Range(Selection, Selection.End(xlToRight)).Select
        slaveWS.Range(Selection, Selection.End(xlDown)).Select
        
        '--- copy
        Selection.Copy
        
        '--- activate masterWS
        masterWS.Activate
        
        '--- get rowIndex & select last empty row
        rowIndex = Application.ActiveSheet.Range("A1048576").End(xlUp).Row + 1
        masterWS.Range("A" & rowIndex).Select
        
        '--- paste
        masterWS.Paste
        
        '--- close slaveWS
        Application.DisplayAlerts = False
        Workbooks(xFile.Name).Close
        Application.DisplayAlerts = True
        
        '--- clear slaveWS
        Set slaveWS = Nothing
        
        '--- printout the status
        Debug.Print "(" & seqNum & " of " & totalFiles & ") File '" & xFile.Name & "' has been extracted"
        
        '--- next
        seqNum = seqNum + 1
    Next xFile
    
    If xIsSubfolders Then
      For Each xSubFolder In xFolder.SubFolders
        ExtractExcelContents xSubFolder.Path, True
      Next xSubFolder
    End If
    
    Set xFile = Nothing
    Set xFolder = Nothing
    Set xFileSystemObject = Nothing
End Sub

Private Function GetFilenameWithoutExtension(ByVal FileName)
  Dim Result, i
  Result = FileName
  i = InStrRev(FileName, ".")
  If (i > 0) Then
    Result = Mid(FileName, 1, i - 1)
  End If
  GetFilenameWithoutExtension = Result
End Function

Private Function CountFilesInFolder(strDir As String, Optional strType As String) As Long
    Dim file As Variant, i As Long
    
    If Right(strDir, 1) <> "\" Then strDir = strDir & "\"
    file = Dir(strDir & strType)
    While (file <> "")
        i = i + 1
        file = Dir
    Wend
    
    CountFilesInFolder = i
End Function