(04/11/2020, 12:27)feraz yazdı: Merhaba.
Alttakibi deneyin.Eğer veriniz çoksa ve yavaş çalışırsa dizi yöntemi ilede yapılır.

Sub Aktar()

    Dim syfForum As Worksheet

    Dim i As Long, son As Long, sonVer As Long

    Set syfForum = ThisWorkbook.Sheets("Form")

    

    With ThisWorkbook.Sheets("Veri")

        son = .Cells(Rows.Count, "M").End(3).Row

        If son < 2 Then son = 2

        If WorksheetFunction.CountA(.Range("M2:M" & Rows.Count)) = 0 Then GoTo son

        Application.ScreenUpdating = False

        For i = 2 To son

            sonVer = syfForum.Range("A" & Rows.Count).End(3)(2, 1).Row

            syfForum.Cells(sonVer, 1).Value = .Cells(i, "F").Value

            syfForum.Cells(sonVer, 2).Value = .Cells(i, "S").Value & " " & .Cells(i, "G").Value

            syfForum.Cells(sonVer, 3).Value = .Cells(i, "B").Value & "-" & .Cells(i, "C").Value

            syfForum.Cells(sonVer, 4).Value = .Cells(i, "L").Value

            syfForum.Cells(sonVer, 5).Value = .Cells(i, "D").Value

        Next

        MsgBox "Akrarma Tamam...", vbInformation, "Aktarma"

        Application.ScreenUpdating = True

    End With

    GoTo son2

son:

    MsgBox "Akrarma Basarisiz...", vbExclamation, "Aktarma"

son2:

    Set syfForum = Nothing

End Sub

FERUZ BEY AKTARMA YAPTI. AMA HEPSİNİ AKTARIYOR. SADECE"Yabancı Araç Plakasına" OLANI AKTARACAK