Копирование массива данных со страницы на страницу - VBA

Формулировка задачи:

День добрый. Впервые столкнулся с необходимостью создания макроса на Excel, нужна помощь специалистов Есть книга Excel, в ней 2 листа с таблицами: Таблица 1 (Лист 1) Таблица 2 (Лист 2) Из первой таблицы во вторую необходимо перенести, например, все данные из столбцов "ФИО" и "Подразделение". При этом количество строк будет варьироваться. То есть нужно, чтобы копировались данные не строго с А2 по А10, а, как бы, с А2 по Абесконечность. Это вообще возможно?

Решение задачи: «Копирование массива данных со страницы на страницу»

textual
                            Листинг программы 
                        
 
                            
                        
Option Explicit
 
'Ключи собираем одним циклом по исходным данным.
'Затем вложенные циклы (3 шт.) по итогу:
'1 - по фио
'2 - по шапке первая строка с шагом 3
'3 - по шапке вторая строка 1-3
'собираем из этих 3-х значений ключ, если есть в словаре - извлекаем данные.
 
 
Sub tt()
    Dim a(), i&, ii&, iii&, t$
    Dim d1 As Object, d2 As Object
 
    Application.ScreenUpdating = False
 
    a = Sheets(1).[a1].CurrentRegion.Value
    Set d1 = CreateObject("scripting.dictionary"): d1.comparemode = 1
    Set d2 = CreateObject("scripting.dictionary"): d2.comparemode = 1
    For i = 2 To UBound(a)
        d1.Item(a(i, 1) & "|" & a(i, 8)) = a(i, 9)
        d2.Item(a(i, 1)) = a(i, 3)
    Next
 
    With Sheets(2)
        .UsedRange.Offset(2).ClearContents
        .[a3].Resize(d2.Count, 2) = Application.Transpose(Array(d2.keys, d2.items)) 'вываливаем фамилии и должности
        For i = 3 To 2 + d2.Count
            For ii = 3 To 12 Step 3
                For iii = 1 To 3
                    t = .Cells(i, 1) & "|" & .Cells(1, ii) & "." & .Cells(2, ii + iii - 1)
                    If d1.exists(t) Then .Cells(i, ii + iii - 1) = d1.Item(t)
                Next: Next: Next
    End With
 
    Application.ScreenUpdating = True
End Sub