Option Explicit

Sub CopyData_zaknafein()
    Dim wbB         As Workbook
    Dim cell        As Range

    Dim fileBPath   As String
    fileBPath = ThisWorkbook.Path & "\" & "0520106.xlsx"    ' Измените на фактический путь ко второму файлу

    Dim wsA1        As Worksheet
    Set wsA1 = ThisWorkbook.Worksheets("Лист1")

    Dim wsA2        As Worksheet
    Set wsA2 = ThisWorkbook.Worksheets("Лист2")

    With Application
        .ScreenUpdating = False
        .DisplayAlerts = False
        .Calculation = xlCalculationManual

        On Error Resume Next
        Set wbB = Workbooks.Open(fileBPath, ReadOnly:=True)
        On Error GoTo 0
        If wbB Is Nothing Then MsgBox "Не удалось открыть файл!", vbExclamation: Exit Sub

        Dim wsB     As Worksheet
        Set wsB = wbB.Worksheets(1)

        For Each cell In wsA1.Range("A2:A" & wsA1.Cells(Rows.Count, 1).End(xlUp).Row)
            Dim foundCell As Range
            Set foundCell = wsB.Range("A:A").Find(cell.Value, LookAt:=xlWhole)

            If Not foundCell Is Nothing Then
                Dim targetSheet As Worksheet
                Set targetSheet = IIf(foundCell.Offset(0, 3).Value = 456, wsA1, wsA2)
                targetSheet.Cells(cell.Row, 1).Resize(1, 4).Value = foundCell.Resize(1, 4).Value
            End If

        Next cell

        wbB.Close False

        .Calculation = xlCalculationAutomatic
        .DisplayAlerts = True
        .ScreenUpdating = True
    End With

End Sub