Klosör ve alt klosörlerden veri çekme.!!!!

[sinan05]

iyi günler. . Çalışma kitabıma Aşağıya eklediğim makro ile kayıtlar klosörünün içindeki satışta adındaki alt klosörde bulunan dosyadan veri çekiyorum. şimdi kayıtlar klosörüne bir kaç alt klosör daha ekledim. istediğim kayıtlar klosöründe nekadar alt klosör varsa içindeki dosyalardaki aşağıdaki kodlarda belirtilen verileri çekmek. Lütfen yardımcı olabilrmisiniz.

Sub Dosyalardan_Urun_Getir()
Application.ScreenUpdating = False
Dim evn As Object, klasoradi As String, kitap As Workbook
Dim i As Integer, x As Integer, dosyam As Workbook
Set kitap = ThisWorkbook
kitap.Sheets("ANA SAYFA").Range("a3:I65536").ClearContents
klasoradi = "KAYITLAR\SATIŞTA"
Set evn = CreateObject("scripting.filesystemobject")
Set dosyalar = evn.getfolder(ThisWorkbook.Path & Application.PathSeparator & klasoradi)
For Each klasor In dosyalar.Files
Set dosyam = GetObject(klasor.Path)
For i = 1 To dosyam.Sheets.Count
For x = 2 To 2

dosyam.Sheets(i).Range("a" & x & ":ı" & x).Copy
kitap.Sheets("ANA SAYFA").Range("a65536").End(3)(2, 1).PasteSpecial xlPasteValues
Next x
Next i
dosyam.Close False
Next klasor

Range("M5").Select
Set evn = Nothing: Set kitap = Nothing: Set dosyam = Nothing
Application.ScreenUpdating = True
End Sub