Klasör İçerisindeki Excel Dosyalarını Tek Dosyada Birleştirme

Klasör İçerisindeki Excel Dosyalarını Tek Dosyada Birleştirme - Baskı Önizleme

+- AccessTr.neT (https://accesstr.net)
+-- Forum: Microsoft Excel (https://accesstr.net/forum-microsoft-excel.html)
+--- Forum: Excel Cevaplanmış Soruları (https://accesstr.net/forum-excel-cevaplanmis-sorulari.html)
+--- Konu Başlığı: Klasör İçerisindeki Excel Dosyalarını Tek Dosyada Birleştirme (/konu-klasor-icerisindeki-excel-dosyalarini-tek-dosyada-birlestirme.html)

Sayfalar: 1 2 3 4 5 6 7

RE: Klasör İçerisindeki Excel Dosyalarını Tek Dosyada Birleştirme - berduş - 23/04/2021

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"

RE: Klasör İçerisindeki Excel Dosyalarını Tek Dosyada Birleştirme - yyhy - 23/04/2021

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?

RE: Klasör İçerisindeki Excel Dosyalarını Tek Dosyada Birleştirme - yyhy - 23/04/2021

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

RE: Klasör İçerisindeki Excel Dosyalarını Tek Dosyada Birleştirme - berduş - 23/04/2021

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

RE: Klasör İçerisindeki Excel Dosyalarını Tek Dosyada Birleştirme - feraz - 23/04/2021

(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

RE: Klasör İçerisindeki Excel Dosyalarını Tek Dosyada Birleştirme - feraz - 23/04/2021

@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 Img-grin