Sub tt()
    With Sheets("Лист3")'Для Лист3
        r01_ = 9'Первая строка
        n1_ = .Cells(.Rows.Count, 1).End(3).Row - r01_ - 1'последняя строка минус нач. строка +1 = кол-во строк
        ar1 = .Cells(r01_, 1).Resize(n1_, 9)'в массив все с ячейки А9 на n1 вниз и на 9 вправо
    End With
    Set slov = CreateObject("Scripting.Dictionary")'slov- это словарь
    With slov'работаем с ним
        For i = 1 To n1_'цикл по строкам массива ar1
            .Item(ar1(i, 1)) = i'в словаре ключ = значение из столбца 1 масссива, элемент = порядковому номеру
        Next i
        With Sheets("Лист1")'для Лист1
            r0_ = 7'первая строка
            n_ = .Cells(.Rows.Count, 4).End(3).Row - r0_ + 1'кол-во строк
            ar0 = .Cells(r0_, 4).Resize(n_)'значения первого столбца суем в массив
        End With
        Dim ar'объявляем переменную
        ReDim ar(1 To n_, 1 To 4)'переобъявляем как массив n строк и 4 столбца
        For i = 1 To n_'цикл по строкам
            If .exists(ar0(i, 1)) Then'если значение из первого столбца ar0 есть в словаре
                ri_ = .Item(ar0(i, 1))'определяем порядковый номер этого значения в массиве ar1 (это элемент сообтветствующего ключа в словаре)
                ar(i, 1) = ar1(ri_, 9)'заполняем массив ar нужными значениями из массива ar1
                ar(i, 2) = ar1(ri_, 7)'
                ar(i, 3) = ar1(ri_, 8)'
                ar(i, 4) = ar1(ri_, 6)'
            End If
        Next i
    End With
    Sheets("Лист1").Cells(r0_, 12).Resize(n_, 4) = ar'выгружаем массив ar на лист
End Sub