Макросы. Выбор данных из множества файлов.

Макрос для выбора данных.

Вот так выглядит Меню выбора для запроса.

В столбец "Лист" - вносим наименование Листа (из источника), в столбец "Ячейка" - наименование ячейки из которой необходимо выбрать данные (кол-во запросов не ограничено, так же, как и файлов). Скачать файл можно после перевода на содержание и развитие сайта.

Для остальных, начнем свое повествование. Создадим Модуль (кто не знает - обращаемся к Введению) и вставим макрос..

Sub gerData()
Dim fName
Dim srcBook
Dim configBook
Dim rwIndex
Dim colIndex
Dim CloseSrc
Dim RG1 As Range
    
Set configBook = ThisWorkbook
Set RG1 = configBook.Worksheets(1).Range("D4:IV10000")
RG1.Clear
thisFName = ThisWorkbook.FullName
fName = Application.GetOpenFilename(fileFilter:="Выберите файлы.*, *.*", MultiSelect:=True)

If IsArray(fName) Then
Dim i
 For i = 1 To UBound(fName)
  If thisFName <> fName(i) Then
  ' Открываем
  CloseSrc = False
  Dim j
   For j = 1 To Workbooks.Count
    If Workbooks(j).FullName = fName(i) Then Set srcBook = Workbooks(j)
   Next j
    If Not IsObject(srcBook) Then
     Set srcBook = Workbooks.Open(Filename:=fName(i), ReadOnly:=True, UpdateLinks:=0)
     CloseSrc = True
    End If
    ' Читаем
    Dim k
    Dim Code
    Dim srcSheet
    Dim srcRange
    Dim rangeFound
    k = 5
     While Not IsEmpty(configBook.Worksheets(1).Cells(k - 1, 1))
      srcSheet = configBook.Worksheets(1).Cells(k - 1, 1).Value
      srcRange = configBook.Worksheets(1).Cells(k - 1, 2).Value
      rangeFound = False
      Dim l
       For l = 1 To srcBook.Sheets.Count
        If srcBook.Sheets(l).Name = srcSheet Then
        
          Code = srcBook.Sheets(srcSheet).Range(srcRange).Value
          configBook.Sheets(1).Cells(i + 3, k).Value = Code
          
          rangeFound = True
          Exit For
        End If
       Next l
            If Not rangeFound Then
             configBook.Sheets(1).Cells(i, k).Value = srcSheet
             configBook.Sheets(1).Cells(i, k).Font.Color = RGB(255, 0, 0)
            End If
      k = k + 1
      Wend
        configBook.Sheets(1).Cells(i + 3, 4).Value = srcBook.Name
          ' Закрываем, если надо...
           If CloseSrc Then srcBook.Close SaveChanges:=False
           Set srcBook = Nothing
           srcBook = ""
  End If
 Next i
End If
End Sub

Вот вообщем-то и все...