Arama kodu hata veriyor

[erenn44]

ustalar ömer hocamdan Allah razı olsun bu kodu yapmış bende yararlanmak için uygulamama aldım ama hata veriyor ya hatayı açınca bu satır Loop While Not c Is Nothing And c.Address <> Adr sarı oluyor ne olur bir el atın yav anlayanlardan yardım bekliyorum ellerinize sağlık şimdiden

 

[mancubus]

sayfada aranan değerden 1 adet var ise bu hatayı veriyor.
ilginç.

For i = 1 To Worksheets.Count satırının bir üstüne
On Error Resume Next satırını ekleyin.

bu komut hata ile karşılaşılsa dahi kodun sonraki satırlarının icra edilmesini sağlar. dikkatli kullanılmalıdır. ama FIND metodu kullanıldığı için burada sakınca olmaz.





ilk döngüden sonra başka komut olmadığı için bu hali ile kalabilir.
ama başka satırlar da olsa idi aşağıdaki eklemeleri yapmak yararlı olacaktı. başka hata çıkarsa kod çalışmasını durduracak ve hata mesajı verecekti.

Next i satırının bir altına
On Error Goto 0

 

[Korhan Ayhan]

Alternatif olarak aşağıdaki kodu deneyiniz.

Option Explicit

Sub BUL_LISTELE()
    Dim S1 As Worksheet, Sayfa As Worksheet
    Dim Bul As Range, Adres As String
    Dim Aranan As Variant
    Dim Satir As Integer
    
    Set S1 = Sheets("Arama")
    S1.Range("A2:A" & Rows.Count).Clear
    Satir = 2
    Aranan = S1.Range("A1")
    
    For Each Sayfa In ThisWorkbook.Worksheets
        If Sayfa.Name <> "Arama" Then
            Set Bul = Sayfa.Cells.Find(Aranan, , , xlWhole)
            If Not Bul Is Nothing Then
                Adres = Bul.Address
10              S1.Hyperlinks.Add Anchor:=S1.Cells(Satir, 1), Address:="", SubAddress:="'" & Sayfa.Name & "'!" & Bul.Address
                Satir = Satir + 1
                Set Bul = Sayfa.Cells.FindNext(After:=Bul)
                If Not Bul Is Nothing Then
                    If Bul.Address <> Adres Then GoTo 10
                End If
            End If
        End If
    Next

    Set Bul = Nothing
    Set S1 = Nothing

    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

 

[erenn44]

korhan hocam çok teşekkür ederim sağolun

 

[erenn44]

mancubus hocam çok teşekkürler korhan hocamın vermiş olduğu kod işimi çözmüştür.