Dosyaların farklı hücrelerinden veri alma

[torqanum]

Bir alt klasördeki dosyaların farklı hücrelerinden veri alıp raporlama yapmak istiyorum. Dosyaların biçimleri, yapıları, başlıkları aynı olup sadece içeriği farklı. Her biri, bir müşterinin bilgilerini içeriyor. Örneklere bakarak bir şeyler yapmaya çalıştım. Sadece [plan$AD1:AF1] şeklinde bir aralık verebiliyorum. Aynı kayıt setinde farklı hücreler verilebilir mi? Şurdan şunu alsın, burdan bunu alsın gibi. Şimdiden çok teşekkür ederim. Kod aşağıdadır:

Sub rapor()
Dim klasor As Object, dosyalar As Object, con As Object, rs As Object
Dim kira As Double, borc As Double
Dim yol As String, dosyaad As String, musteri As String
Dim evn As Scripting.Filesystemobject

Set evn = New Scripting.Filesystemobject
yol = ThisWorkbook.Path & "\ARSIV\"
Set klasor = evn.getfolder(yol)
Set con = CreateObject("adodb.connection")
Set rs = CreateObject("adodb.recordset")

Range("A2100").ClearContents

For Each dosyalar In klasor.Files
If dosyalar.Name <> "000.xls" Then
dosyaad = Replace(dosyalar.Name, ".xls", "")
con.Open "provider=microsoft.jet.oledb.4.0;data source=" & dosyalar.Path & _
";extended properties=""excel 8.0;hdr=no"""
rs.Open "select * from [plan$AD1:AF1]", con, 1, 1
musteri = IIf(IsNull(rs.Fields(0).Value), "", rs.Fields(0).Value)
kira = IIf(IsNull(rs.Fields(1).Value), "", rs.Fields(1).Value)
borc = IIf(IsNull(rs.Fields(2).Value), "", rs.Fields(2).Value)
rs.Close: con.Close
With Range("a65536")
.End(3)(2, 1).Value = dosyaad
.End(3)(1, 2).Value = musteri
.End(3)(1, 3).Value = kira
.End(3)(1, 4).Value = borc
End With
End If
Next dosyalar

Set rs = Nothing: Set con = Nothing: Set evn = Nothing
Set klasor = Nothing: Set dosyalar = Nothing
yol = vbNullString: dosyaad = vbNullString
adet = Empty: tutar = Empty

End Sub