Banka ekstralarında hesap kodunu yazdırma,

[bilalakdeniz]

Merhaba arkadaşlar, Tüm bankalarımı excelde hazırlamış olduğum dosyada tutuyorum ve Muhasebe proğramımıza bu dosyadan aktarıyoruz, Tanımlamış olduğum kelimelere ait hesap kodlarını R hücresine yazmasını istiyorum. Teşekkürler,

 

[Orion1]

Dosyanız ektedir.
Sayfa adı rakam olanlara bakıyor.

Sub sorgula_59()
Dim aranan As String, sh As Worksheet, adr As String
Dim i As Long, sat1 As Long, sat2 As Long, k As Range, kod As String
Sheets("ARANACAK KELİMELER").Select
sat1 = Cells(65536, "B").End(xlUp).Row
If sat1 < 2 Then
    MsgBox "Aranacak kelime yok" & vbLf & "İşlem iptal oldu", vbCritical, "UYARI"
    Exit Sub
End If
Application.ScreenUpdating = False
For i = 2 To sat1
    aranan = Cells(i, "B").Value
    If aranan = "" Then GoTo atla
    If Cells(i, "C").Value <> "" Then
        kod = Cells(i, "C").Value
        Else
        kod = 120.999
    End If
    For Each sh In Worksheets
        If IsNumeric(sh.Name) Then
            sat2 = sh.Cells(65536, "B").End(xlUp).Row
            If sat2 > 5 Then
                Set k = sh.Range("B6:B" & sat2).Find(aranan, , xlValues, xlPart)
                If Not k Is Nothing Then
                    adr = k.Address
                    Do
                        sh.Cells(k.Row, "R").Value = kod
                        Set k = sh.Range("B6:B" & sat2).FindNext(k)
                    Loop While Not k Is Nothing And k.Address <> adr
                End If
                Set k = Nothing
            End If
        End If
    Next sh
atla:
Next i
Application.ScreenUpdating = True
MsgBox "İşlem Tamamlanmıştır" & vbLf & "evrengizlen@hotmail.com", _
vbOKOnly + vbInformation, "E V R E N"
End Sub

 

[bilalakdeniz]

Çok Teşekkür ederim, Elinize sağlık,

 

[bilalakdeniz]

Sayın Evren Gizlen, Yazmış olduğunuz makro çok güzel ve işlerimi çok kolaylaştıracak, Çok Teşekkür Ederim. Bir sorum olacaktı, Her banka ekstrasının Açıklama bölümü B sutununda olmuyor, (B:K) sutunlarının arasında aratmamız mümkünmü?

 

[bilalakdeniz]

Evren Bey Sorumu çözdüm teşekkürler,