Çok sayıda kapalı dosyadan bir kriterde, farklı satır ve sütunlardan veri toplama

[o.demir]

Arkadaşlar, macro ve combobox gibi birkaç konuyu inceledim. Fakat problemim için yeni soru sormam gerektiğine karar verdim.
Elimde çok sayıda excel dosyası var. Tam olarak yapmak istediğim şey ise, bu kapalı dosyalarda bir metin arayıp o metini bulduğunda, o satırın sağındaki 4 hücreden veriyi alıp yeni excel dosyasına kopyalamaktır. Bir sayfada birden çok veri kopyalama yapabilir. Her kopyalamayı satırlar halinde yapmak istiyorum. Bunun için makro yapmak yeterli midir? Kaç değişken tanımlamalıyım? Bana yardımcı olursanız sevinirim. Ayrıca örnek bir dosya hazırlayabilirim gerekirse. Teşekkürler.

 

[Levent Menteşoğlu]

Veri alınacak en az iki dosya, verilerin kaydedileceği bir örnek dosya eklerseniz yardımcı olmaya çalışırız.

 

[o.demir]

Dosyaları ekledim. Umarım anlatabilmişimdir. Ek olarak, veri taranıp alınacak satır aralığı 5:115'tir.

 

[Levent Menteşoğlu]

Ekli dosyayı ve klasörü kaydettikten sonra "AYIKLAMA.xlsm" dosyasını açın ve B1 hücresine "dosyalar" isimli klasörün yolunu örnekteki gibi yazın. Daha sonra B2 hücresine kriteri yazdıktan sonra "verileri al" butonuna basın.

Not: AYIKLAMA.xlsm dosyası mutlaka "dosyalar" isimli klasörün dışında bulunmalıdır.

 

[o.demir]

Teşekkürler Levent Bey.

 

[o.demir]

Makro, veri alınacak dosyalarda "sayfa1" isimli çalışma sayfalarına bakıyor. Yalnız benim tüm çalışma kitaplarımdaki çalışma sayfa ismi "MONTAJLI SET". Makroda ikinci satırdaki s1 değişkenine MONTAJLI SET atamayı denedim fakat makro çalışmadı. Sorun nedir acaba?

Sub verilerial()
Set s1 = Sheets("sayfa1")
s1.[a4:z65536].ClearContents

 

[Levent Menteşoğlu]

İlgili kodu aşağıdaki ile değiştirin. Eğer Ayıklama.xlsm dosyası içindeki verilerin alındığı sayfanın adıda "MONTAJLI SET" ise bu durumda aşağıdaki satırıda değiştirin.

Set s1 = Sheets("sayfa1") yerine Set s1 = Sheets("MONTAJLI SET")

​

Sub verilerial()
Set s1 = Sheets("sayfa1")
s1.[a4:z65536].ClearContents
For Each dosya In CreateObject("Scripting.FileSystemObject").GetFolder(s1.[b1]).Files

Set baglanti = CreateObject("ADODB.Connection")
Yol = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & s1.[b1] & dosya.Name & ";Extended Properties=""Excel 12.0;HDR=no;IMEX=1"";"
baglanti.Open Yol
Set rs = baglanti.Execute("SELECT F1,F2,F3,F5,F6 from [[COLOR=Red]'MONTAJLI SET'[/COLOR]$M:R65536] where F1 like '%" & s1.[b2] & "%'")
sat = WorksheetFunction.CountA(s1.[a4:a65536]) + 4
s1.Cells(sat, "a").CopyFromRecordset rs

Set rs = baglanti.Execute("SELECT F1,F2,F3,F5,F6 from [[COLOR=Red]'MONTAJLI SET'[/COLOR]$V:AA65536] where F1 like '%" & s1.[b2] & "%'")
sat = WorksheetFunction.CountA(s1.[h4:h65536]) + 4
s1.Cells(sat, "h").CopyFromRecordset rs

Next
rs.Close
baglanti.Close
End Sub