Private Sub CommandButton1_Click()
    ri = 2 ' Сброс /Счетчик строк для цикла While -> Wend
    
    While Лист1.Cells(ri, 9) <> "" ' Начало Перебор строк по условию "пока ячейка не пуста"
        
        For i = 1 To 1000 ' Начало /Цикл перебора данных для подстановки
            If Str(Лист1.Cells(ri, 9)) & Str(Лист1.Cells(ri, 10)) = Str(Лист2.Cells(i, 1)) & Str(Лист2.Cells(i, 2)) Then ' Поиск соответствий
                Лист1.Cells(ri, 12) = Лист2.Cells(i, 3) ' Запись найденых соответствий на Лист1
                    Лист1.Cells(ri, 11) = Лист2.Cells(i, 4) ' Запись найденых соответствий на Лист1
            End If
        Next i
    
    ri = ri + 1 ' Следующая строка /Счетчик строк для цикла While -> Wend
    Wend ' Конец /Перебор строк по условию "пока ячейка не пуста"
    
End Sub

Range("D3").Select
    Selection.AutoFill Destination:=Range("D3:D1000000")
    Range("D3:D11160").Select

Sub PRIMER()
'
' PRIMER Макрос
'

'
    Columns("B:B").Select
    Selection.TextToColumns Destination:=Range("B1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=True, _
        Semicolon:=False, Comma:=False, Space:=True, Other:=False, OtherChar _
        :="/", FieldInfo:=Array(Array(1, 4), Array(2, 2)), TrailingMinusNumbers:=True
    Selection.NumberFormat = "m/d/yyyy"
    Columns("E:G").Select
    Selection.NumberFormat = "0"
End Sub

Sub xlsx_csv_1()
'
    For Each wb In Workbooks
        If Windows(wb.Name).Visible Then
            MsgBox wb.Path & "\" & Left(wb.Name, InStrRev(wb.Name, ".")  - 1)
            ActiveWorkbook.SaveAs Filename:=Left(wb.Name, InStrRev(wb.Name, ".")  - 1) & ".csv" _
                , FileFormat:=xlCSV, CreateBackup:=False
        End If
    Next wb
End Sub