Sub СопоставитьСчета()
    Dim ws1 As Worksheet
    Dim ws2 As Worksheet
    Dim lastRow1 As Long
    Dim lastRow2 As Long
    Dim i As Long
    Dim j As Long
    Dim currentRow As Long
    Dim companyFound As Boolean
    
    ' Установим ссылки на листы по индексам
    Set ws1 = ThisWorkbook.Sheets(1) ' Первый лист в книге
    Set ws2 = ThisWorkbook.Sheets(2) ' Второй лист в книге
    
    ' Найдем последнюю строку в каждом листе
    lastRow1 = ws1.Cells(ws1.Rows.Count, 1).End(xlUp).Row
    lastRow2 = ws2.Cells(ws2.Rows.Count, 1).End(xlUp).Row
    
    ' Проходим по всем счетам на Листе1
    For i = 2 To lastRow1 + 1000 ' Начинаем с 2, чтобы пропустить заголовок на Листе1, + 1000 добавлено эксперементальным путем
        
        If ws1.Cells(i, 1).Value <> "" Then ' Проверяем, что счет не пустой
            
            ' Ищем совпадения по счету и компании на Листе2, + 1000 добавлено эксперементальным путем
            For j = 2 To lastRow2 + 1000
                
                If ws1.Cells(i, 1).Value = ws2.Cells(j, 1).Value Then ' Совпадение по счету
                    
                    companyFound = False
                    
                    If ws1.Cells(i, 2).Value = ws2.Cells(j, 2).Value Then ' Совпадение по компании
                        companyFound = True
                        ' Переносим сумму из Листа2 в Лист1
                        ws1.Cells(i, 3).Value = ws2.Cells(j, 3).Value
                    End If
                    
                End If
                
            Next j
            
            ' Если компания не найдена на Листе2 для данного счета, добавляем новые строки с компаниями из Листа2 под последней найденной компанией для этого счета на Листе1
            If Not companyFound Then
                
                For j = 2 To lastRow2
                    
                    If ws1.Cells(i, 1).Value = ws2.Cells(j, 1).Value And _
                       Application.WorksheetFunction.CountIf(ws1.Range("B:B"), ws2.Cells(j, 2).Value) = 0 Then
                    
                        i = i + 1 ' Переходим к следующей строке для вставки новой компании

                        ' Вставляем новую строку и переносим данные из Листа2 в Лист1
                        ws1.Rows(i).Insert Shift:=xlDown

                        ws1.Cells(i, 1).Value = ws2.Cells(j, 1).Value
                        ws1.Cells(i, 2).Value = ws2.Cells(j, 2).Value
                        ws1.Cells(i, 3).Value = ws2.Cells(j, 3).Value

                    End If
                    
                Next j
                
            End If
            
        End If
        
    Next i
    
    MsgBox "Сопоставление завершено!"
End Sub