Verilen metni çalışma kitabındaki bütün sayfalarda arayan ve bulunanları mesaj olarak gösteren VBA kodudur.
Option Explicit
Sub ButunSayfalardaAraVeBulunanlariMesajOlarakGoster()
'---------------------------------------
'Değişkenler
'---------------------------------------
Dim sayfa As Object
Dim bulunacak As Variant
Dim ilkHucre As Range
Dim sonrakiHucre As Range
Dim mesaj As String
'---------------------------------------
'Arama metnini ayarla.
'---------------------------------------
bulunacak = Application.InputBox( _
"Arama metnini giriniz: ", _
"Arama Yap", , 100, 100, , , 2)
'---------------------------------------
'Arama metni uygunsa işlem yap.
'---------------------------------------
If bulunacak <> "" And Not bulunacak = False Then
'---------------------------------------
'Bütün sayfalarda arama yap.
'---------------------------------------
For Each sayfa In ActiveWorkbook.Worksheets
sayfa.Activate
sayfa.[A1].Activate
Set ilkHucre = Cells.Find(What:=bulunacak, _
LookIn:=xlValues, LookAt:=xlPart, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
'---------------------------------------
'İlk hücreyi (varsa) bul.
'---------------------------------------
If Not ilkHucre Is Nothing Then
ilkHucre.Activate
mesaj = Chr(34) & bulunacak & Chr(34) & " | " _
& sayfa.Name & "!" & ilkHucre.Address
MsgBox mesaj
On Error Resume Next
'---------------------------------------
'Sonraki hücreleri bul.
'---------------------------------------
While (Not sonrakiHucre Is Nothing) And _
(Not sonrakiHucre.Address = ilkHucre.Address)
Set sonrakiHucre = Cells.FindNext(After:=ActiveCell)
If Not sonrakiHucre.Address = ilkHucre.Address Then
sonrakiHucre.Activate
mesaj = Chr(34) & bulunacak & Chr(34) & " | " _
& sayfa.Name & "!" & sonrakiHucre.Address
MsgBox mesaj
End If
Wend
End If
'---------------------------------------
'Değişkenleri temizle.
'---------------------------------------
Set sonrakiHucre = Nothing
Set ilkHucre = Nothing
bulunacak = Empty
sayfa = Empty
mesaj = Empty
Next
End If
End Sub