Yardım Açık Dosyaya 2 Kapalı Dosyadan Veri Arama/Aktarma,

Sub Emre()
    Dim i&, osma As Range, ac As Workbook, syf As Worksheet
    Application.ScreenUpdating = False
    Set ac = Workbooks.Open(ThisWorkbook.Path & "\Siparis\Ocak2019.XLSX")
    Set syf = ac.Worksheets(1)
    With ThisWorkbook.Worksheets(1)
        For i = 2 To .Range("A65536").End(3).Row
            Set osma = ac.Worksheets(1).Columns(8).Find(.Cells(i, 1).Value, , , 1)
            If Not osma Is Nothing Then
                .Cells(i, "AP").Value = syf.Range("C" & osma.Row).Value
                .Cells(i, "AQ").Value = syf.Range("G" & osma.Row).Value
                .Cells(i, "AR").Value = syf.Range("I" & osma.Row).Value
                .Cells(i, "AS").Value = syf.Range("L" & osma.Row).Value
                .Cells(i, "AT").Value = syf.Range("O" & osma.Row).Value
            End If
        Next i
    End With
    ac.Close False
    Application.ScreenUpdating = True
    Set syf = Nothing: Set ac = Nothing: Set evn = Nothing: i = Empty
End Sub