(04/11/2020, 17:21)berduş yazdı: tarih alanı verileri hangi sütundan alıyor?
bu arada aşağıdaki kodu dener misiniz?

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")

    syfForum.Range("A2:F" & Rows.Count).ClearContents



        Application.ScreenUpdating = False

    

Dim Sql As String

Dim ADO_CN As Object

Dim ADO_RS As Object



Set ADO_CN = CreateObject("Adodb.Connection")

Set ADO_RS = CreateObject("adodb.recordset")



SQL = "SELECT F6,  format(cdate(F19),'dd.mm.yyyy') & ' ' & F7, F2 & '-' & F3, F12, F4  "

SQL = Sql & vbCrLf

SQL = Sql & "FROM [Veri$" & "] where F13='Yabancı Araç Plakasına' ;"



ADO_CN.ConnectionString = "provider=Microsoft.ACE.OLEDB.12.0;data source=" & ThisWorkbook.FullName & _

";extended properties=""excel 8.0;hdr=no;imex=1"""

ADO_CN.Open

ADO_RS.Open SQL, ADO_CN, 3, 1

'

'  Eğer Hiç Kayıt Yoksa

    If ADO_RS.RecordCount = 0 Then

        ADO_RS.Close

        ADO_CN.Close

        Set ADO_RS = Nothing

        Set ADO_CN = Nothing

        MsgBox "Kayıt Bulunamadı.", vbCritical, "Veri Yok"

        Exit Sub

    End If

ADO_RS.movelast

ADO_RS.movefirst

Debug.Print ADO_RS.RecordCount

  syfForum.Range("a2").CopyFromRecordset ADO_RS



ADO_RS.Close

ADO_CN.Close

Set ADO_RS = Nothing

Set ADO_CN = Nothing

'

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

        Application.ScreenUpdating = True

    End With

    GoTo son2

son:

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

son2:

    Set syfForum = Nothing

End Sub

SQL = "SELECT F6,  format(cdate(F19),'dd.mm.yyyy') & ' ' & F7, F2 & '-' & F3, F12, F4  "

SQL = Sql & vbCrLf

SQL = Sql & "FROM [Veri$" & "] where F13='Yabancı Araç Plakasına' ;"

Yukarıdaki kodu alttaki gibi değiştiriseniz hem kod kısalır hemde toplam tutar sayısal olur abey.
Kod bendede çalıştı.

SQL = "SELECT F6,  format(cdate(F19),'dd.mm.yyyy') & ' ' & F7, F2 & '-' & F3, F12, cdbl(F4) "

SQL = Sql & "FROM [Veri$] where F13='Yabancı Araç Plakasına' ;"

            If LCase(veri(i, 13)) = "yabancý araç plakasýna" Then

                say = say + 1

                arr(i, 1) = veri(i, 6)

                arr(i, 2) = veri(i, 19) & " " & veri(i, 7)

                arr(i, 3) = veri(i, 2) & " " & veri(i, 3)

                arr(i, 4) = veri(i, 12)

                arr(i, 5) = veri(i, 4)

            End If

Zaman bulunca kodu inceleyim dedim hatalı yazmışım 5.mesajdaki kodu.
Doğrusu alttaki gibi olacak yani arr(i,1) gibi yerlerdeki i yerine say gelecekti
Koduda değiştiririm birazdan.
Ayrıca formatlamalarınıda yapıp tamamını eklerim kodun.

            If LCase(veri(i, 13)) = "yabancı araç plakasına" Then

                say = say + 1

                arr(say, 1) = veri(i, 6)

                arr(say, 2) = veri(i, 19) & " " & veri(i, 7)

                arr(say, 3) = veri(i, 2) & " " & veri(i, 3)

                arr(say, 4) = veri(i, 12)

                arr(say, 5) = veri(i, 4)

            End If

Kodun en son hali alttadır.

Sub Aktar()

    Dim syfForum As Worksheet, arr(), veri(), say As Long

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

    Set syfForum = ThisWorkbook.Sheets("Form")

    

    say = 0

    With ThisWorkbook.Sheets("Veri")

        syfForum.Range("A2:F" & Rows.Count).ClearContents

        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

        veri = .Range("A2:S" & son).Value

        ReDim arr(1 To son, 1 To 19)

        For i = LBound(veri) To UBound(veri)

            If LCase(CStr(veri(i, 13))) = "yabancı araç plakasına" Then

                say = say + 1

                arr(say, 1) = veri(i, 6)

                arr(say, 2) = Format(veri(i, 19), "dd.mm.yyyy") & " " & Format(CStr(veri(i, 7)), "hh:mm")

                arr(say, 3) = veri(i, 2) & "-" & veri(i, 3)

                arr(say, 4) = veri(i, 12)

                arr(say, 5) = veri(i, 4)

            End If

        Next

        Application.ScreenUpdating = True

        If say > 0 Then

            syfForum.Range("A2").Resize(say, 5).Value = arr

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

        End If

        

    End With

    GoTo son2

son:

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

son2:

    Set syfForum = Nothing: Erase arr: Erase veri

End Sub

cdbl(F4) yerine ccur(F4) yazsak olur mu?
Kusura bakmayin bilgisayar olmadigindan deneyemedim.

(04/11/2020, 23:05)berduş yazdı: cdbl(F4) yerine ccur(F4) yazsak olur mu?
Kusura bakmayin bilgisayar olmadigindan deneyemedim.

Olabilir benim bildiğim ccur parabirimine çeviriyor.Eğer ingilizce Excel kullanılırsa dolar işareti çıkması gerek kendi bilgisayarımda bir deneyetim normalde € çıkması gerek bende.

O alan Toplam ceza tutarinin olduğu alan ise para turunden olmasi daha uygun olur diye düşündüm genelde
ofis kurulurken bulundugumuz ulkeyi secmissek sorun yok ama dediginiz gibi yerel ayarlardaki para birimi farkliysa sorun cikabilir.