Birden Fazla Klasörden Veri Çekmek

[aLp59]

Arkadaşlar merhaba,

Birden fazla klasörden excel sayfasından şartlı veri çekmek istiyorum.

Örnekte anlatmaya çalıştım.

Teşekkürler

 

[aLp59]

Sub Birlestir()
Dim anaDosya As Workbook
Dim altDosya As Workbook
Dim altKlasor As Object
Dim yol As String
Dim dosyaAdi As String
Dim hedefSayfa As Worksheet
Dim satir As Long
Dim hedefDosya As Workbook

' Ana Excel dosyasını belirleyin
Set anaDosya = ThisWorkbook

' Hedef Excel dosyasını oluşturun
Set hedefDosya = Workbooks.Add
Set hedefSayfa = hedefDosya.Sheets(1)

' Kontrol edilecek klasör yolunu belirleyin
yol = "C:\klasor_yolu\" ' Kendi klasör yolunuzu buraya yazın

' Belirtilen klasördeki tüm dosyaları dolaşın
dosyaAdi = Dir(yol & "*.xls*")

' Tüm dosyaları kontrol edin
Do While dosyaAdi <> ""
' Excel dosyasını açın
Set altDosya = Workbooks.Open(yol & dosyaAdi)

' TİZ1 adlı sayfayı kontrol edin
If altDosya.Sheets("TİZ1") Is Nothing Then
' TİZ1 sayfası yoksa sonraki dosyaya geçin
altDosya.Close SaveChanges:=False
Else
' TİZ1 sayfasındaki verileri alın
For satir = 4 To 74
hedefSayfa.Cells(hedefSayfa.Cells(Rows.Count, 1).End(xlUp).Row + 1, 1).Resize(1, 7).Value = altDosya.Sheets("TİZ1").Range("A" & satir & ":G" & satir).Value
Next satir

' Dosyayı kapatın
altDosya.Close SaveChanges:=False
End If

' Bir sonraki dosyayı alın
dosyaAdi = Dir
Loop

' Hedef dosyayı kaydedin
hedefDosya.SaveAs "C:\hedef_klasor\hedef_dosya.xlsx" ' Kendi hedef klasör ve dosya adınızı buraya yazın

' Hedef dosyayı kapatın
hedefDosya.Close SaveChanges:=False

' Mesaj gösterin
MsgBox "Birleştirme işlemi tamamlandı!"
End Sub

Arkadaşlar kodu yazdım sadece tüm klasörlere bakacak şekilde ayarlayamıyorum.

Yardımcı olursanız sevinirim.