Необходимо сопоставить два столбца excel

Sub Макрос1()
 
    'Здесь нужно указать, с какой строки начинаются данные.
    Const lНачальнаяСтрока As Long = 4
 
    Dim rFind As Excel.Range, sAddress As String
    Dim i As Long
    
    'Указываем, с какой строки начать двигаться по столбцу A.
    i = lНачальнаяСтрока
    
    'Отключаем обновление монитора, чтобы код работал быстрее.
    Application.ScreenUpdating = False
    
    'Двигаемся по столбцу A, пока не достигнем пустой ячейки.
    Do While IsEmpty(Cells(i, "A")) = False
        
        'Ведём поиск в столбце G.
        With Columns("G")
            Set rFind = .Find(What:=Cells(i, "A").Text, LookIn:=xlValues, _
                LookAt:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, _
                MatchCase:=False, SearchFormat:=False)
                
            If Not rFind Is Nothing Then
                'Запоминаем первуню найденную ячейку в столбце G,
                'чтобы затем остановить цикл поиска.
                sAddress = rFind.Address
                
                Do
                    
                    'Заносим данные в столбцы O и P.
                    Cells(rFind.Row, "O").Value = Cells(i, "B").Value
                    Cells(rFind.Row, "P").Value = Cells(i, "C").Value
                    
                    'Ищем дальше в столбце G.
                    Set rFind = .FindNext(rFind)
                    
                Loop While sAddress <> rFind.Address
                
            End If
 
        End With
        
        
        'Переход к следующей строке в столбце A.
        i = i + 1
        
    Loop
    
    'Включаем обновление монитора.
    Application.ScreenUpdating = True
    
    'Сообщение, что работа завершена.
    MsgBox "Работа завершена!", vbInformation
 
End Sub