yüzlerce excelden tek excel oluşturmak

[kakara]

Merhaba ustadlarım tek klasor ıcınde ısımlerı farklı yuzlerce excel mevcut tum excellerın formatı aynı bellı bır bolumu alt alta gelıcek sekılde bır excel dosyasında toplamak ıstıyorum daha detaylı bılgıyı ektekı dosyada anlatmaya calıstım ılgınız ıcın sımdıden tesekkurler

 

[Erkan Akayay]

Her dosyada sayfa isimlerinin aynı olduğunu varsayarak ADO ile kapalı dosyadan veri alma kodu oluşturdum.
Ana dosyanın nerede olduğu önemli değil ama klasörün olduğu yeri kodda düzeltmeniz gerekiyor.
Set klasor = Fso.GetFolder("C:\Users\admin\Desktop\deneme\")
kısmından bahsediyorum.

Sub DosyalardanGetir()

Dim con As Object, rs As Object, sorgu As String, Yol As String
Dim Fso As Object, klasor As Object, dosyalar As Object, satir As Integer

Set con = CreateObject("ADODB.Connection")
Set rs = CreateObject("ADODB.Recordset")

Set Fso = CreateObject("Scripting.FileSystemObject")
Set klasor = Fso.GetFolder("C:\Users\admin\Desktop\deneme\")
satir = Range("A1").End(1).Row + 1

For Each dosyalar In klasor.Files
    If dosyalar.Name <> ThisWorkbook.Name And VBA.Left(dosyalar.Name, 2) <> "~$" Then
        con.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & dosyalar.Path & ";Extended Properties=""Excel 12.0;HDR=NO"""
        sorgu = "SELECT F3 FROM [Sayfa2$A1:C8]"
        rs.Open sorgu, con, 1, 1
        Cells(satir, 1).Resize(, rs.RecordCount) = rs.getrows
        rs.Close: con.Close
        satir = satir + 1
    End If
Next dosyalar

Set con = Nothing: Set rs = Nothing: sorgu = vbNullString: satir = Empty
End Sub

 

[kakara]

@Erkan Akayay tesekkurler ustadım kodunuz calısıyor.