Ado Kapalı dosyadan satır satır veri Alma...

[ikikan]

Kolay gelsin arkadaşlar aşadaki koda dosya yolu, adı, sayfasındaki tüm verileri aktarmakta. Bu koda bir eklenti yapıp ilgili sayfadaki ilgili Satırdaki veriyi nasıl getire biliriz?

Sub VeriGetir()
Dim Data As Object, Tablo As Object
Dim D_Yolu, D_Adi, Sy_Adi As String
Dim S_Say As Integer
Dim Bil_1, Bil_2, Bil_3 As Long

    With Application
        .ScreenUpdating = False
        .Calculation = xlCalculationManual
        .EnableEvents = False
        .DisplayAlerts = False
    End With
    
    Sheets("Sayfa2").Select
    Range("A2:DD5000").ClearContents
        If [A1] = "" Or [B1] = "" Then
            MsgBox "Degerler boş. Degerleri giriniz.", vbCritical, "UYARI"
            GoTo Git1
            'Exit Sub
        End If


'D_Yolu = Application.GetOpenFilename("All Files (*.*),*.*.") ' "dosya yolu"
D_Yol = "D:\tse 360 ile ilgili"
D_Adi = "Temel Araç Bilgileri B"
S_Adi = [A1].Value
S_Say = 1 ' buraya satır sayısını yazınca ilgili satırdaki veri gelsin


Set Data = CreateObject("ADODB.Connection")
Set Tablo = CreateObject("ADODB.Recordset")

Data.Open "provider=microsoft.jet.oledb.4.0;data source=" & D_Yol & "\" & D_Adi & ";extended properties=""excel 8.0;iif(hdr,yes,no)"""
'Tablo.Open "Select * from [" & S_Adi & "$];", Data
Set Tablo = Data.Execute("select * from [" & S_Adi & "$]")

Range("A2").CopyFromRecordset Tablo


    Tablo.Close
    Data.Close
    Set Tablo = Nothing: Set Data = Nothing
Git1:

    With Application
        .ScreenUpdating = True
        .Calculation = xlCalculationAutomatic
        .EnableEvents = True
        .DisplayAlerts = True
    End With

End Sub