Public Sub MergeBooks(ssRange As String)
    Dim sRange As Range
    'Set sRange = Workbooks("FormReport46").Worksheets("Лист1").Range(ssRange)
    
    Dim rng As Range
    Dim cnW As ADODB.Connection
    Dim rs As ADODB.Recordset
    Dim iRow As Integer
    Dim fso As Scripting.FileSystemObject
    Dim fl As File
    Dim D As Scripting.Folder
    Dim sFolder As String
    Set cnW = New ADODB.Connection
    Set rs = New ADODB.Recordset
    cnW.CursorLocation = adUseClient
    sFolder = "C:\excel_temp\"
    Set D = fso.GetFolder(sFolder)   'путь к файлу..
        For Each fl In D.Files
        cnW.ConnectionString = "DSN=Файлы Excel;DBQ=" & fl.Name & ";DriverId=790;MaxBufferSize=2048;PageTimeout=5;"
        cnW.Open
        rs.Open "SELECT * FROM [Sheet1$]", cnW, adOpenKeyset, adLockReadOnly
        'определяем последнюю строку
        Set rng = ThisWorkbook.Worksheets( 1 ).Cells( 1 ,  1 ).CurrentRegion
        iRow = rng.Rows.Count +  1 
        Set rng = Nothing
    
        'копируем данные
        ThisWorkbook.Worksheets( 1 ).Range(ThisWorkbook.Worksheets( 1 ).Cells(iRow,  1 ).Address).CopyFromRecordset rs
        rs.Close
        cnW.Close
    
    Next fl
 
    Set rs = Nothing
    Set cnW = Nothing

End Sub

    Function GetFolder(FolderPath As String) As Folder
    Member of Scripting.FileSystemObject
    Получить папку

Set D = fso.GetFolder(sFolder)   'путь к файлу..