100'den Fazla excell dosyasından veri çekme

[ali.cir]

Merhaba,
Çalıştığım şirkette günlük denetim yapıyorum. Denetim formum hep aynı (sadece denetimde ortaya çıkan bulguların numaraları bağımsız) geriye dönük filtreleme yapmak istediğimde yüzlerce dosya yığını karşıma çıkıyor.

Birden fazla dosyadan Tek bir excell dosyasına istediğim verileri bulgu numarası referans alarak aktarabilir miyim ?

Teşekkürler

 

[Necdet]

Merhaba,

Paylaşım sitelerinden birine örnek dosya paylaşıp açıklama yaparsınız, yardımcı olacak arkadaşlar çıkacaktır.
Soyut sorularla sonuca ulaşamayabilirsiniz.

 

[ali.cir]

Merhaba,
Çalıştığım şirkette günlük denetim yapıyorum. Denetim formum hep aynı (sadece denetimde ortaya çıkan bulguların numaraları bağımsız) geriye dönük filtreleme yapmak istediğimde yüzlerce dosya yığını karşıma çıkıyor.

Birden fazla dosyadan Tek bir excell dosyasına istediğim verileri bulgu numarası referans alarak aktarabilir miyim ?

Teşekkürler

Merhaba,
Örnek dosya linkte yer almaktadır.

Denetleme Raporları

MediaFire is a simple to use free service that lets you put all your photos, documents, music, and video in a single place so you can access them anywhere and share them everywhere.

www.mediafire.com

 

[Necdet]

Merhaba,

Aşağıdaki kodları Raporlama dosyasında bir modüle kopyalayıp deneyiniz.

Not : Dosyalar ve Raporlama dosyasının aynı dizinde olması gerekmektedir.

Sub VeriGetir()

    Dim Yol As String, _
        Dsy As String, _
        con As Object, _
        Rs  As Object, _
        Sorgu As String
    
    Application.ScreenUpdating = False
    Range("A1").CurrentRegion.Offset(1, 0).ClearContents
    
    Yol = ThisWorkbook.Path & Application.PathSeparator
    
    Dsy = Dir(Yol & "*.*", vbHidden)
    
    While Dsy <> ""
    
        If Dsy Like "**.**.****.xlsx" Then
            Set con = CreateObject("adodb.Connection")
            Set Rs = CreateObject("adodb.Recordset")
            con.Open "provider=microsoft.ace.oledb.12.0;data source= " & _
                     Yol & Dsy & ";extended properties= ""Excel 12.0;hdr=yes"""
            Sorgu = "Select * From [Sayfa1$]"
            Rs.Open Sorgu, con, 3, 1
            Range("A" & Cells(Rows.Count, "A").End(3).Row + 1).CopyFromRecordset Rs
            Rs.Close
            Set con = Nothing
            Set Rs = Nothing
        End If
        
        Dsy = Dir
        
    Wend
    
    Columns("E:E").NumberFormat = "hh:mm;@"
    
    Application.ScreenUpdating = True
    MsgBox "İşlem Tamamdır...."
    
End Sub

 

[ali.cir]

Merhaba,

Aşağıdaki kodları Raporlama dosyasında bir modüle kopyalayıp deneyiniz.

Not : Dosyalar ve Raporlama dosyasının aynı dizinde olması gerekmektedir.

Sub VeriGetir()

    Dim Yol As String, _
        Dsy As String, _
        con As Object, _
        Rs  As Object, _
        Sorgu As String
   
    Application.ScreenUpdating = False
    Range("A1").CurrentRegion.Offset(1, 0).ClearContents
   
    Yol = ThisWorkbook.Path & Application.PathSeparator
   
    Dsy = Dir(Yol & "*.*", vbHidden)
   
    While Dsy <> ""
   
        If Dsy Like "**.**.****.xlsx" Then
            Set con = CreateObject("adodb.Connection")
            Set Rs = CreateObject("adodb.Recordset")
            con.Open "provider=microsoft.ace.oledb.12.0;data source= " & _
                     Yol & Dsy & ";extended properties= ""Excel 12.0;hdr=yes"""
            Sorgu = "Select * From [Sayfa1$]"
            Rs.Open Sorgu, con, 3, 1
            Range("A" & Cells(Rows.Count, "A").End(3).Row + 1).CopyFromRecordset Rs
            Rs.Close
            Set con = Nothing
            Set Rs = Nothing
        End If
       
        Dsy = Dir
       
    Wend
   
    Columns("E:E").NumberFormat = "hh:mm;@"
   
    Application.ScreenUpdating = True
    MsgBox "İşlem Tamamdır...."
   
End Sub

Oldu çok teşekkür ederim emeğiniz için. Şimdi bunları kendi orjinal dosyama eklemek kaldı sadece

 

[Necdet]

Kolay gelsin