Soru KLASÖR İÇİNDEKİ DOSYALARDAN VERİ ÇEKME

[teknoman]

Merhabalar, benim klasör içerinde günlük düzenli olarak eklediğim dosyalar mevcut.Yapmak istediğim bu dosyalardan belirlediğim belli alanlardaki verileri veri dosyamın içerisine alt alta eklemek. Örneğin ekteki dosyalarda görüldüğü gibi klasörde bulunan dosyalarımda C424 deki verileri "VERİAL" dosyamın B ve C sütünlarına alt alta yapıştırmak ve A sütununa da verilerimin bulunduğu dosya isimlerini getirtmek.Şimdiden hocalarıma teşekkür ederim.İyi çalışmalar dilerim.

 

[teknoman]

Hocalarim yardimlarınızı bekliyorum

 

[teknoman]

Kısaca seçilen klasör içerisinde dosyalardan belirli seçim alanını (örneğin (B2:C18) ) bir dosyada alt alta dosya isimleri ile birlikte birleştirmek mümkün olmaz mı?

 

[sesar]

Hocam selamlar.
Ekle-veri-accesten bölümüne gelip dosyanı seçeceksin. Yalnız bu dosyaların ayrı ayrı değil aynı tabloda olması faydalı olur.

Sonra Örnek1-Ürün1 şeklinde birleştirme yapacaksın. Veri çektirmek istediğin sekmede Örnek1-Ürün1 yazıp diğer sekmeden verileri düşey ara ile çektireceksin.

Dosyalarını birleştirip örnek tek dosya atarsan çalışma yapabilirim.

 

[teknoman]

Hocam ilginiz için teşekkür ederim.Yalnız aşağidaki gibi bir kod buldum.Burada sayfalardaki her kitaptaki verilerimi alabiliyorum lakin A sütununa dosya isimlerini getirtemedim.Bu konuda yardım olacak hocalarımın yardımlarını bekliyorum.


Sub Getir()

Set con = VBA.CreateObject("adodb.Connection")
Set cat = CreateObject("ADOX.Catalog")

'Set klasor = CreateObject("Shell.Application").BrowseForFolder(0, "Lütfen bir klasor seçin !", 1)
Cells.ClearContents

Dim bir As Object
Set bir = CreateObject("scripting.filesystemobject")
yol = ThisWorkbook.Path
Set klasor = bir.getfolder(yol)
For Each dosyalar In klasor.Files
If Not dosyalar.Name Like "*xlsm*" Then
If dosyalar.Name Like "*xls*" Then

con.Open "provider=microsoft.ace.oledb.12.0;data source=" & _
yol & "\" & dosyalar.Name & ";extended properties=""Excel 12.0;hdr=yes"""

cat.ActiveConnection = con
syf = Replace(cat.tables.Item(0).Name, "'", "")

sorgu = "select * from[" & syf & "B140]"
Set rs = con.Execute(sorgu)
son = Cells(Rows.Count, "B").End(3).Row + 1
Range("B" & son).CopyFromRecordset rs
con.Close
End If
End If
Next
End Sub