Excel VBA Макросы: Можно ли макросами подтягивать данные с разного количества вкладок (листов) одинакового формата?

[Toreador]

В эксель-файле неизвестное кол-во вкладок (листов) с одинаковым форматом (т.е. данные, которые нужно подтянуть, находятся на одних и тех же ячейках).
Нужно создать сводную вкладку (лист), которая будет собирать данные со всех листов.
Возможно ли это сделать с помощью макросов?

В вкладку (лист) СВОД надо протянуть построчно данные с вкладок (листов) названные цифрами (таких вкладок будет неизвестное кол-во). Последнюю вкладку не надо подтягивать.
Получается моя  задачи состоит в том, чтобы протянуть в СВОДе фамилии и данные с этих таблиц.

В СВОДе формулы не нужны.

Копировать нужно фрагменты A1:K19. Адреса ячеек нужно указать прямо в коде, макрос не должен искать последнюю строку и последний столбец.

[вложение удалено администратором]

[Администратор]

Макрос

Sub Макрос()

    Dim sh_свод As Worksheet, sh_src As Worksheet
    Dim r_свод As Long, i As Long
   
   
    ' Отключение монитора и формул, чтобы ускорить макрос.
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
   
    '1. Присваиваем листу "СВОД" имя "sh_свод".
        ' Далее в коде будем обращаться к листу по этому имени.
    Set sh_свод = Worksheets("СВОД")
   
    '2. Копирование данных из всех листов, кроме последнего, на лист "СВОД".
    For i = 2 To Worksheets.Count - 1
       
        '1) Присваиваем листу, из которого надо скопировать данные, имя "sh_src".
        Set sh_src = Worksheets(i)
       
        '2) Переходим на лист, чтобы после работы макроса не был выделен копируемый фрагмент
            ' для удобства юзера.
        sh_src.Activate
       
        '3) Сбрасываем автофильтр, чтобы не было скрытых строк (на всякий случай).
        If sh_src.AutoFilterMode = True Then
            sh_src.AutoFilter.ShowAllData
        End If
       
        '4) Установка курсора "r_свод" под последней заполненной строкой на листе "СВОД".
            ' Ошибка будет, если лист "СВОД" пустой.
        On Error Resume Next
        r_свод = sh_свод.Cells.Find(What:="*", LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, _
            SearchDirection:=xlPrevious, MatchCase:=False, SearchFormat:=False).Row
        On Error GoTo 0
        r_свод = r_свод + 1
       
        '5) Копирование данных из листа-источника на лист "СВОД".
        sh_src.Range("A1:K19").Copy
        sh_свод.Cells(r_свод, "A").PasteSpecial xlPasteFormats
        sh_свод.Cells(r_свод, "A").PasteSpecial xlPasteValuesAndNumberFormats
       
    Next i
    Application.CutCopyMode = False
   
    '3. Сбрасываем выделение после копирования.
    Application.Goto sh_свод.Range("A1"), True
   
    '4. Включение и сообщение.
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
    MsgBox "Готово.", vbInformation

End Sub

[свернуть]

[Toreador]

Спасибо большое, все работает отлично.