Çözüldü Birden Fazla Sayfada Arama

[tane45]

Merhabalar,

4 adet sayfam var. Sayfa1,2,3,4. Benim aşağıdaki yazdığım makroya göre yalnızca 1 sayfada arama yapıp bulduğu hücreyi boyatabiliyorum. Birden fazla sayfa da olduğu için diğer sayfalarda da araması gerekiyor. Bu konuda bana yardımcı olabilir misiniz? Aciliyeti söz konusudur.

Private Sub OptionButton2_Click()
Dim aranan As String, bul As Range
    aranan = Sheets("Sayfa2").Range("A2")
    Set bul = Sheets("Sayfa1").Range("A2:A66000").Find(aranan, Lookat:=xlWhole)
    If Not bul Is Nothing Then
        Sheets("Sayfa1").Activate
        bul.Interior.Color = vbRed
    ' bulunamazsa "Sonuç Bulunamadı." diye mesaj göster
    Else
        MsgBox "Sonuç Bulunamadı.", vbInformation, "BİLGİ"
    End If
    Set bul = Nothing
    Sheets("Sayfa2").Rows("2:2").ClearContents 'Sayfa2 sayfasında son dolu satırı siliyoruz.
End Sub

 

[Orion1]

Buyurun.

Dim aranan As String, bul As Range, sh As Worksheet
    aranan = Sheets("Sayfa2").Range("A2")
    For Each sh In Worksheets
        Set bul = sh.Range("A2:A66000").Find(aranan, Lookat:=xlWhole)
        If Not bul Is Nothing Then
            bul.Interior.Color = vbRed
        ' bulunamazsa "Sonuç Bulunamadı." diye mesaj göster
        Else
            MsgBox sh.Name & " Sayfasında Sonuç Bulunamadı.", vbInformation, "BİLGİ"
        End If
        Set bul = Nothing
    Next
    Sheets("Sayfa2").Rows("2:2").ClearContents 'Sayfa2 sayfasında son dolu satırı siliyoruz.

 

[tane45]

Orion1 Hocam teşekkür ederim. Ekrana sürekli bakmaktan çözemiyordum. Eline sağlık
Yalnız bu makroda aşağıdaki satırı yapmıyor hata veriyor. Bilgin olsun. Ben kaldırdım çokta önemli değildi.

 Next
    Sheets("Sayfa2").Rows("2:2").ClearContents 'Sayfa2 sayfasında son dolu satırı siliyoruz.

 

[Orion1]

Sayfa2 diye bir sayfanız olmadığından hata vermiş.
Zaten ben o koda ellemedim.Sizde ne yazıldıysa o şekilde duruyordu.
İyi çalışmalar.

 

[tane45]

Sayfa2 diye bir sayfanız olmadığından hata vermiş.
Zaten ben o koda ellemedim.Sizde ne yazıldıysa o şekilde duruyordu.
İyi çalışmalar.

Dedim ya ekrana bakmaktan beyin gitti diye. kusura bakma

 

[Orion1]

Dedim ya ekrana bakmaktan beyin gitti diye. kusura bakma

Estafurullah.
İyi çalışmalar.

 

[gicimi]

Buyurun.

Dim aranan As String, bul As Range, sh As Worksheet
    aranan = Sheets("Sayfa2").Range("A2")
    For Each sh In Worksheets
        Set bul = sh.Range("A2:A66000").Find(aranan, Lookat:=xlWhole)
        If Not bul Is Nothing Then
            bul.Interior.Color = vbRed
        ' bulunamazsa "Sonuç Bulunamadı." diye mesaj göster
        Else
            MsgBox sh.Name & " Sayfasında Sonuç Bulunamadı.", vbInformation, "BİLGİ"
        End If
        Set bul = Nothing
    Next
    Sheets("Sayfa2").Rows("2:2").ClearContents 'Sayfa2 sayfasında son dolu satırı siliyoruz.

Sayın Evren Hocam kodun çalışma ile ilgili ufak bir örnek excel hazırlamayabilir misiniz.

 

[Orion1]

Sayın Evren Hocam kodun çalışma ile ilgili ufak bir örnek excel hazırlamayabilir misiniz.

Buyurun.

Sub ara_59()
Dim aranan As String, bul As Range, sh As Worksheet
    aranan = Sheets("Sayfa1").Range("A1")
    For Each sh In Worksheets
        sh.Range("A2:A" & Rows.Count).Interior.ColorIndex = xlNone
        Set bul = sh.Range("A2:A" & Rows.Count).Find(aranan, Lookat:=xlWhole)
        If Not bul Is Nothing Then
            bul.Interior.Color = vbRed
        ' bulunamazsa "Sonuç Bulunamadı." diye mesaj göster
        Else
            MsgBox sh.Name & " Sayfasında Sonuç Bulunamadı.", vbInformation, "BİLGİ"
        End If
        Set bul = Nothing
    Next
End Sub

 

[gicimi]

@Orion1 Evren Hocam Eline sağlık