Sub Выбрать()

Dim MyPath As String, iFileName As String 
 
MyPath = "Здесь путь твой\"
 
iFileName = Dir(MyPath)

 Do While iFileName <> ""
      If UCase(Right(iFileName,  3 )) = "XLS" Then
         msgbox iFileName
      End If
  iFileName = Dir
 Loop


End Sub

'Выбрать файлы XLS в каталоге и подкаталогах
Sub Запуск()
Dim fso As New FileSystemObject

' Запускаешь процедуру перебора книг в каталоге и подкаталогах с указанием пути
' в примере для 3-х каталогов, можно добавить строк скольеко нужно и изменить путь
 ВыбратьКаталогПодкаталогиFSO fso.GetFolder("Y:\!")
 ВыбратьКаталогПодкаталогиFSO fso.GetFolder("\\Ukdc\Common\СФД\Общая\!sad")
 ВыбратьКаталогПодкаталогиFSO fso.GetFolder("Y:\sad")
End Sub

'FileSystemObject - БИБЛИОТЕКА  Microsoft Scripting Runtime
Sub ВыбратьКаталогПодкаталогиFSO(Папка As Folder)
Dim fso As New FileSystemObject, fold As Folder, iFile As File

 For Each fold In Папка.SubFolders
   ВыбратьКаталогПодкаталогиFSO fold        'лезем в рекурсию
 Next
  
 For Each iFile In Папка.Files
   If UCase(Right(iFile,  3 )) = "XLS" Then
      ОбработчикФайла (iFile.Path)
   End If
 Next
End Sub

Sub ОбработчикФайла(pathFile As String)
Dim openWb  As Workbook
 Workbooks.Open pathFile, False
 Set openWb = ActiveWorkbook
 'Вместо строки MsgBox вставить любую обработку открытой книги openWb
 'Можно не открывать книгу а скопировать данные из закрытой книги, но об этом в следующий раз
  MsgBox "Имя открытой книги - " & openWb.Name
 
 openWb.Close False
End Sub

Dim svod As Workbook
Dim fso As New FileSystemObject

Sub Запуск()
' назначаем сводную книгу
Set svod = Workbooks("База.xls")
'очищаем сводный лист от старья
svod.Sheets("Лист1").Range("A10:BF65536").ClearContents
' Запускаешь процедуру перебора книг в каталоге и подкаталогах с указанием пути
' в примере для 3-х каталогов, можно добавить строк скольеко нужно и изменить путь
 ВыбратьКаталогПодкаталогиFSO fso.GetFolder("Y:\!")
 ВыбратьКаталогПодкаталогиFSO fso.GetFolder("\\Ukdc\Common\СФД\Общая\!sad")
 ВыбратьКаталогПодкаталогиFSO fso.GetFolder("Y:\sad")
End Sub

'Выбрать файлы XLS в каталоге и подкаталогах
'FileSystemObject - БИБЛИОТЕКА  Microsoft Scripting Runtime
Sub ВыбратьКаталогПодкаталогиFSO(Папка As Folder)
Dim fold As Folder, iFile As file

 For Each fold In Папка.SubFolders
   ВыбратьКаталогПодкаталогиFSO fold        'лезем в рекурсию
 Next
  
 For Each iFile In Папка.Files
   If UCase(Right(iFile,  3 )) = "XLS" Then
      ОбработчикФайла (iFile.path)
   End If
 Next
End Sub


Sub ОбработчикФайла(foolpathFile As String)

 Dim fname As String, fpath As String, sh As String
 Dim lastRow As Long
    ' имя исходного файла
    fname = Split(foolpathFile, "\")(UBound(Split(foolpathFile, "\")))
    ' путь к исходному файлу
    fpath = Left(foolpathFile, Len(foolpathFile) - Len(fname))
    ' Лист в исходных файлах
    sh = "Лист1"

    With svod.Sheets("Лист1")
     ' следующая после последней строка на сводном листе
     lastRow = .Cells.Find("*", , , , xlByRows, xlPrevious).Offset( 1 ).Row
     ' заполнение этой строки значениями из очередной книги
     ' слева указываешь столбцы из сводного листа
     ' справа указываешь адресс ячейки которую нужно перенести в данный столбец
        .Range("B" & lastRow).Value = GetCel(fpath, fname, sh, "A1")
        .Range("C" & lastRow).Value = GetCel(fpath, fname, sh, "A2")
        .Range("D" & lastRow).Value = GetCel(fpath, fname, sh, "A3")
        ' /// и т.д.
        
    End With
        
End Sub
' Функция получающая одну ячейку из закрытой книги
' Если возвращает #ССЫЛКА!, то скорее всего указанного листа в данной книге не существует
Private Function GetCel(fpath, fname, sh, rngStr)
  Dim formulaStr As String
    formulaStr = "'" & fpath & "[" & fname & "]" & sh & "'!" & Range(rngStr).Address(, , xlR1C1)
    Debug.Print formulaStr
    GetCel = ExecuteExcel4Macro(formulaStr)
End Function

    Debug.Print formulaStr

 For Each iFile In Папка.Files
   If UCase(iFile.Name) Like "ALG*.XLS" Then ОбработчикФайла (iFile.path)
 Next