Как сравнить две таблицы и совпадающие элементы перенести в другую таблицу

Sub Procedure_1()
    
    'Здесь указываем номер строки первого листа, с
    'которой начинаются данные.
    Const myStart As Long = 3
    
    Dim myRange As Excel.Range
    Dim myColumn As Long
    Dim mySheet_2End As Long, mySheet_3End As Long
    Dim mySearchRange As Excel.Range
    Dim myFind As Excel.Range, myAddress As String
    Dim i As Long
    
    Dim shSheet_1 As Excel.Worksheet
    Dim shSheet_2 As Excel.Worksheet
    Dim shSheet_3 As Excel.Worksheet
    
    '1. Даём имена листам. Через эти имена будем обращаться к листам.
    'Так удобнее писать код.
    Set shSheet_1 = Worksheets(1)
    Set shSheet_2 = Worksheets(2)
    Set shSheet_3 = Worksheets(3)
    
    '2. Пользователь выбирает столбец с данными на первом листе.
    'Не путайте "InputBox" программы Excel и "InputBox" языка программирования VBA.
    'Type:=8 - означает, что будет взяты не данные из ячейки, а сама ячейка.
    'Если поставить курсор на слово "InputBox" и нажать клавишу "F1",
    'то появится справка и можно подробнее посмотреть параметры команды "InputBox".
    Set myRange = _
        Application.InputBox(Prompt:="Выберите одну ячейку в нужном столбце", Type:=8)
    
    '3. Берём номер столбца, который выбрал пользователь.
    myColumn = myRange.Column
    
    '4. Задаём диапазон, в котором будем искать на втором листе.
    '4.1. Определяем последнюю строку с даннными на втором листе.
    mySheet_2End = shSheet_2.Cells(shSheet_2.Rows.Count, "B").End(xlUp).Row
    '4.2. Задаём диапазон.
    Set mySearchRange = shSheet_2.Range("B2:B" & mySheet_2End)
    
    '5. Определяем, куда вставлять данные на третьем листе.
    'Т.к. я не знаю, по какому столбцу определить окончание данных,
    'то определю последнюю строку в отношении всего листа.
    'What:="?" - знак вопроса в этом случае - это специальный символ.
    'SearchDirection:=xlPrevious - поиск с конца в начало.
    '"+1", т.к. данные нужно вставлять в пустую строку.
    mySheet_3End = shSheet_3.Cells.Find(What:="?", LookIn:=xlValues, _
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, _
        MatchCase:=False, SearchFormat:=False).Row + 1
 
    '6. Выполнение задания.
    'Двигаемся по первому листу по выбранному столбцу до последней строки с данными.
    'shSheet_1.Cells(shSheet_1.Rows.Count, myRange.Column).End(xlUp) - это
        'аналогично, если сделать на листе активной ячейку в последней строке
        'и нажать сочетание клавиш "Ctrl + стрелка вверх".
    'shSheet_1.Rows.Count - это количество строк на листе.
    'shSheet_1.Cells(shSheet_1.Rows.Count, myRange.Column).End(xlUp).Row - это
        'номер строки, где заканчиваются данные в выбранном столбце.
    For i = myStart To shSheet_1.Cells(shSheet_1.Rows.Count, myColumn).End(xlUp).Row Step 1
    
        'Ищем данные из текущей ячейки первого листа на втором листе.
        'В параметре "What" должен быть текст, поэтому нужно преобразовать
        'данные из ячейки в текст с помощью CStr на случай, если в ячейке
        'содержится не текст, а что-то другое. Иначе будет ошибка и код остановит работу.
        'After:=mySearchRange.Cells(mySearchRange.Cells.Count, 1) - поиск ведётся
            'после указанной ячейки, поэтому поиск нужно вести с конца диапазона,
            'чтобы собирать данные в нужном порядке.
        Set myFind = mySearchRange.Find(What:=CStr(shSheet_1.Cells(i, myColumn).Value), _
            After:=mySearchRange.Cells(mySearchRange.Cells.Count, 1), LookIn:=xlValues, _
            LookAt:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, _
            MatchCase:=False, SearchFormat:=False)
    
        'Смотрим, есть ли результат поиска.
        If Not myFind Is Nothing Then
            
            'Запоминаем адрес первой найденной ячейки,
            'чтобы потом остановить поиск.
            myAddress = myFind.Address
            
            Do
            
                'Переносим данные со второго на третий лист.
                shSheet_3.Range("B" & mySheet_3End & ":E" & mySheet_3End).Value = _
                    shSheet_2.Range("B" & myFind.Column & ":E" & myFind.Column).Value
                
                'Переход к следующей строке на третьем листе.
                mySheet_3End = mySheet_3End + 1
                
                'Следующий поиск тех же самых данных.
                Set myFind = mySearchRange.FindNext(myFind)
                
            Loop While myFind.Address <> myAddress
            
        End If
        
    Next i
    
    'Сообщение, что работа кода завершена.
    MsgBox "Работа кода завершена.", vbInformation
    
End Sub