Kapalı dosyadan sorgulama

[tahsinanarat]

D sürücüsünde farklı klasör içerisinde ekte gönderdiğim dosyalarım bulunmakta, Garantidışı çalışma kitabımın Takipedilecekler sayfasında H sütununda girdiğim kriterlerin, Kapalı olan Günlük_kasa çalışma kitabımın Yedek_liste adlı sayfasında A sütununda bulunan hücre içirişinden bulup a sütunundaki bilgiyi I sütununa, b sütunundaki karşılığı olan tutarı ise J sütununa getirmesini istiyorum.
Yardımcı olacak arkadaşlarıma şimdiden teşekkür ederim.

 

[tahsinanarat]

Aşağıdaki kod ile hallettim sanırım, yarın iş yerinde deneyeceğim

Sub KOD_OPEN_İLE()
Application.DisplayAlerts = False
Application.ScreenUpdating = False

Dim KK As Worksheet
Dim KA As Worksheet
Dim BUL

Range("I2:J65536").ClearContents

yol = "D:\TAN TEKNİK\Günlük_kasa.xlsm"
Workbooks.Open (yol)

Set KK = Workbooks("Günlük_kasa").Sheets("Liste_Yedek")
Set KA = Workbooks("Garantidışıfişler").Sheets("Takipedilecekler")

For i = 2 To KA.[H65536].End(3).Row

Set BUL = KK.Range("A:A").Find(KA.Cells(i, "h"), , xlValues, xlPart)

If Not BUL Is Nothing Then

KA.Cells(i, "I") = KK.Cells(BUL.Row, "a")
KA.Cells(i, "J") = KK.Cells(BUL.Row, "b")
End If

Next i

Workbooks("Günlük_kasa").Close False

Application.DisplayAlerts = True
Application.ScreenUpdating = True
MsgBox " B i t t i ", vbInformation, "KOD_OPEN_İLE"

End Sub

Not: kodlar daha evvelce bu siteden alıntıdır. Kim yazdıysa eline sağlık.