Dim con As ADODB.Connection

    Set con = New ADODB.Connection

eğer referanssız kullanmak isterseniz yukardaki 2 satırı silip aşağıdaki satırı ekleyebilirsiniz.

Set con = CreateObject("adodb.connection")

kodunu kullanmayı deneyebilirsiniz
sıra numarası derken kast ettiğiniz tam olarak ne?
@feraz beyin önerdiği

        If WorksheetFunction.CountA(.Range("B2:B" & Rows.Count)) > 0 Then

            son = .Range("B" & Rows.Count).End(3).Row

            .Range("A2").Value = 1

          .Range("A2:A" & son).DataSeries Rowcol:=xlColumns, Type:=xlLinear, Date:=xlDay, Step:=1, Stop:=son

        End If

kodunu kullandınız mı?

---

kodu aşağıdaki gibi düzenleyip dener misiniz?
Not: Referansa gerek yok
sıralama için æferaz hocamın kodu kullanılmıştır

    Set con = CreateObject("adodb.connection")

    con.Open "provider=microsoft.ace.oledb.12.0;data source=" & ThisWorkbook.FullName & ";extended properties=""excel 8.0;hdr=yes;"""

    

    yol = ThisWorkbook.Path & Application.PathSeparator

    yol2 = Dir(yol & "*xlsx")

    

    With ThisWorkbook.Sheets("TümVeri")

        .Range("A2:Q" & Rows.Count).Clear

        Do Until yol2 = ""

             txtSql = "INSERT INTO  [TümVeri$]  " & _

                      "SELECT  * " & _

                      "FROM [MEMURLAR$] IN '" & yol & yol2 & "'[EXCEL 8.0;] " & _

                      "where ([SİCİL] Is Not Null);"

             con.Execute txtSql

        

        yol2 = Dir

        Loop

        

    If WorksheetFunction.CountA(.Range("B2:B" & Rows.Count)) > 0 Then

            son = .Range("B" & Rows.Count).End(3).Row

            .Range("A2").Value = 1

          .Range("A2:A" & son).DataSeries Rowcol:=xlColumns, Type:=xlLinear, Date:=xlDay, Step:=1, Stop:=son

        End If

    End With



    con.Close: Set con = Nothing



    MsgBox "Bitti", vbInformation, "Bilgi"

Verileri 00 -Tüm Veri bu kitaba getirirken 00 -Tüm Veri bu kitapta a2 den itibaren aşağıya doğru sıra numarası vermek istiyorum.
Ayrıca son kodu da çalıştıramadım. Örnek dosya ekleyebilir misiniz?

Son mesajı uyguladım ama hücrelerde mavi tik kalıyor. Dosyayı da ekliyorum.

referans eklenmiş ve sıralanmış haliyle dosya eklenmiştir
okla gösterilen alanlar ekleme süresini görmek içindir, silinebilirler

Private Sub CommandButton1_Click()

    t1 = Now'<--Silinebilir

    Dim con As ADODB.Connection

    Set con = New ADODB.Connection

    con.Open "provider=microsoft.ace.oledb.12.0;data source=" & ThisWorkbook.FullName & ";extended properties=""excel 8.0;hdr=yes;"""

    

    yol = ThisWorkbook.Path & Application.PathSeparator

    yol2 = Dir(yol & "*xlsx")

       

        With ThisWorkbook.Sheets("TümVeri")

        .Range("A2:Q" & Rows.Count).Clear

        Do Until yol2 = ""

             txtSql = "INSERT INTO  [TümVeri$]  " & _

                      "SELECT * " & _

                      "FROM [MEMURLAR$] IN '" & yol & yol2 & "'[EXCEL 8.0;] " & _

                      "where ([SİCİL] Is Not Null);"

             con.Execute txtSql

        

        yol2 = Dir

        Loop

        If WorksheetFunction.CountA(.Range("B2:B" & Rows.Count)) > 0 Then

            son = .Range("B" & Rows.Count).End(3).Row

            .Range("A2").Value = 1

            .Range("A2:A" & son).DataSeries Rowcol:=xlColumns, Type:=xlLinear, Date:=xlDay, Step:=1, Stop:=son

        End If

'Alan dönüşüm_______________________________________

  .Range("B2:B" & son).NumberFormat = "0"

  .Range("B2:B" & son).Value = .Range("B2:B" & son).Value

  .Range("D2" & son).NumberFormat = "0"

  .Range("D2" & son).Value = .Range("D2" & son).Value

  .Range("F2" & son).NumberFormat = "0"

  .Range("F2:F" & son).Value = .Range("F2:F" & son).Value

'_________________________________________________

    End With



    con.Close: Set con = Nothing



        t2 = Now'<--Silinebilir

    Debug.Print "Tur", t1, t2, DateDiff("s", t1, t2)'<--Silinebilir

    MsgBox "Bitti", vbInformation, "Bilgi"

End Sub

(23/04/2021, 00:11)yyhy yazdı: Sayın farez bey acaba sizde çalışan 00 -Tüm Veri dosyayı buraya ekyebilirmisiniz? Sayın @berduş beyin attığı kodu da çalıştıramadım.

Tüm dosyaları ekledim abey.A sütununda veriolmasın  derseniz alttaki kodları silin.

        If WorksheetFunction.CountA(.Range("B2:B" & Rows.Count)) > 0 Then

            son = .Range("B" & Rows.Count).End(3).Row

            .Range("A2").Value = 1

          .Range("A2:A" & son).DataSeries Rowcol:=xlColumns, Type:=xlLinear, Date:=xlDay, Step:=1, Stop:=son

        End If

@berduş hocam sanki bir ara bu insert into için çok fazla veri içn bilgisayarı kilitliyor çok uzun çalışıyor diye demiştiniz yanılmıyorsam