Soru Klasör İçeriğinde Bulunan Excel Dosyasındaki Satırları Ayrı Bir Excel Dosyasına Yazdırma

[Hattushil]

Bir klasörde kişi taleplerinin girişi yaptığım excel tabloları mevcut.

Klasör içeriğindeki dosyaların adlarını aşağıdaki makro ile excel tablosuna yazdırabiliyorum ama klasörün içerisindeki excel tablolarında bulunan satırları başka bir excele yazdırmak istiyorum.
Bunun için aşağıdaki makroda nasıl bir değişiklik yapmam gerekir ya da başka türlü yapma şansım var mı?

Not: Klasör içeriğinde bulunan dosyaların adları farklı ve içerdiği satır sayıları da farklılık göstermekte.

Sub Dosya_Listele()
Columns("A:B").ClearContents
Set Klasor = CreateObject("shell.application").BrowseForFolder(0, "Kaynak Dosyaları İçeren Klasörü Seçin", 50, &H0)
If Not Klasor Is Nothing Then
Kaynak = Klasor.SELF.Path
If InStr(1, Kaynak, "{") > 0 Then GoTo Atla
If Right(Kaynak, 1) <> "\" Then Kaynak = Kaynak & "\"
Liste (Kaynak)
Set Klasor = Nothing
MsgBox "işlem tamam"
Else
Atla:
MsgBox "Lütfen Kaynak Klasör Seçimini Yapınız !", vbInformation, "DİKKAT"
End If
End Sub

Private Sub Liste(yol As String)
Dim fL As Object, fs As Object, f As Object, j As Long, n As Long
Set fL = CreateObject("Scripting.FileSystemObject").GetFolder(yol).subfolders
Set fs = CreateObject("Scripting.FileSystemObject").GetFolder(yol).Files
If Right(yol, 1) <> "\" Then ekle = "\"
On Error Resume Next
For Each Dosya In fs
j = WorksheetFunction.CountA(Worksheets(ActiveSheet.Name).Range("a1:a" & Rows.Count)) + 1
Cells(j, 1) = yol & ekle & Dosya.Name
Cells(j, 2) = Dosya.Name
Next
On Error GoTo sonraki
For Each f In fL
Liste (f.Path)
sonraki:
Next
Set fL = Nothing
End Sub

             
             

 

[Hattushil]

Salı günü yukarıdaki makroyu nasıl düzenleyebilirim diye sormuştum ama cevap yazan olmadı,
Rica etsem tecrübeli arkadaşlar inceleyebilir mi?