Klasördeki dosyalardan veri alırken dosya adını da getirmek

[Barfly]

Merhaba,

Aşağıdaki kod ile klasör içerisindeki tüm uygun dosyalardan A:H sütunları arasındaki veriyi alıp rapor dosyasında B sütunundan başlamak üzere alt alta sıralatabiliyorum. Yapmak istediğim ise bu işlem olurken A sütununa da ilgili dosyaların isimleri gelsin. Örneğin Ahmet isimli dosyanın içerisindeki veri 20 satırsa rapor dosyasında bu 20 satırın verisi B:I sütunlarına yazılırken A sütunu da 20 satır boyunca ilgili dosyanın adıyla dolsun. Bu konuda yardımcı olabilecek var mıdır?

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 & "A1:H]"
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