Zoeken in alle werkbladen in een bepaalde Range

[ZZ1]

Ik ben al een tijd aan het stoeien met een VBA code.
Op dit moment redt ik mij ermee alleen het werkt nog niet optimaal.

Het gaat om de volgende code:

Sub SearchAreas_A2()
For j = 1 To 15
      Dim ThisAddress$, Found, FirstAddress
      Dim Lost$, N&, NextSheet&
      Dim CurrentArea As Range, SelectedRegion As Range
      Dim Reply As VbMsgBoxResult
      Dim FirstSheet As Worksheet
      Dim Ws As Worksheet
      Dim Wks As Worksheet
      Dim Sht As Worksheet

Set FirstSheet = ActiveSheet
Lost = ActiveSheet.Cells(1)(19 + j, 1)
If Lost = Empty Then End
For Each Ws In Worksheets
     Ws.Select
     With ActiveSheet.Cells
          Set FirstAddress = .Find(What:=Lost, LookIn:=xlValues)
          If FirstAddress Is Nothing Then
               GoTo NextSheet
          End If
          FirstAddress.Select
          Reply = MsgBox("Zoekt u dit " & Lost & "?", vbQuestion + vbYesNo, "Current Region")
          Set Found = .Find(What:=Lost, LookIn:=xlValues)
          Set FirstAddress = .Find(What:=Lost, LookIn:=xlValues)
          If Reply = vbYes Then
               GoTo Afdrukken:
          End If
          ThisAddress = FirstAddress.Address
          Do
          Loop While Not FirstAddress Is Nothing And FirstAddress.Address <> ThisAddress
     End With
     
NextSheet:
      Next Ws
      
Afdrukken:
If Reply = vbYes Then

A = MsgBox("Wilt u dit afdrukken?", vbYesNo, "")

If A = vbYes Then
     Application.Dialogs(xlDialogPrint).Show
End If

If A = vbNo Then
End If

Sheets("Blad1").Select
Range("A1").Select
     GoTo Doorlopen:
     
Else
     FirstSheet.Select
     MsgBox "Zoekactie afgerond - Geen meer resultaten van " & Lost & " s gevonden", vbInformation, "No Region Selected"

Sheets("Blad1").Select
Range("A1").Select
     GoTo Doorlopen:
End If

Doorlopen:
     Next
          Call SearchAreas_A3
End Sub

Zoals ik al aangaf werkt deze code al goed, alleen nog niet optimaal.

Ik krijg het maar niet voor elkaar om het volgende:
* Hij moet een bepaalde tekst vinden in "Blad1" en dit zal hij in alle werkbladen moeten zoeken behalve in "Blad1" en in een Range van A1:K2

Wat zal ik aan deze code moeten veranderen zodat ik dit werkend krijg.
Heb bovenstaande code van internet afgehaald, en deels aangepast.

 

[Superzeeuw]

ZZ1,

Zoiets?

 

[ZZ1]

ZZ1,

Zoiets?

Dit is wel iets wat ik zoek.
Heb deels jouw code erin verwerkt, maar nu krijg ik de volgende foutmelding:
"Fout 1004 tijdens uitvoering:

Methode Select van klasse Range is mislukt"

Dat geeft hij bij de volgende regel:
FirstAddress.Select

Hier nu mijn volledige code:

Sub SearchAreas_A5()
For j = 1 To 10

      Dim ThisAddress$, Found, FirstAddress
      Dim Lost$, N&, NextSheet&
      Dim CurrentArea As Range, SelectedRegion As Range
      Dim Reply As VbMsgBoxResult
      Dim FirstSheet As Worksheet
      Dim Ws As Worksheet
      Dim Wks As Worksheet
      Dim Sht As Worksheet
      
Set FirstSheet = ActiveSheet
Lost = ActiveSheet.Cells(7)(7 + j, 1)
If Lost = Empty Then End
     For x = 2 To Sheets.Count
          With Worksheets(x).Range("A1:IV2")
               Set FirstAddress = .Find(What:=Lost, LookIn:=xlValues)
               If FirstAddress Is Nothing Then
                    GoTo NextSheet
               End If
[COLOR="red"]               FirstAddress.Select[SIZE="1"] (dit is de beroemde regel)[/SIZE][/COLOR]
               Reply = MsgBox("Zoekt u dit " & Lost & "?", vbQuestion + vbYesNo, "Current Region")
               Set Found = .Find(What:=Lost, LookIn:=xlValues)
               Set FirstAddress = .Find(What:=Lost, LookIn:=xlValues)
               If Reply = vbYes Then
                    GoTo Afdrukken:
               End If
               ThisAddress = FirstAddress.Address
               Do
               Loop While Not FirstAddress Is Nothing And FirstAddres.Address <> ThisAddress
          End With

NextSheet:
     Next x
     
Afdrukken:
If Reply = vbYes Then

A = MsgBox("Wilt u dit afdrukken?", vbYesNo, "")

If A = vbYes Then
     Application.Dialogs(xlDialogPrint).Show
End If

If A = vbNo Then
End If

Sheets("Blad1").Select
Range("A1").Select
     GoTo Doorlopen:
     
Else
     FirstSheet.Select
     MsgBox "Zoekactie afgerond - Geen meer resultaten van " & Lost & " gevonden", vbInformation, "No Region Selected"
     
Sheets("Blad1").Select
Range("A1").Select
     GoTo Doorlopen:
End If

Doorlopen:
     Next
End Sub

Ik wil deze code juist gebruiken omdat:
Als hij het woord heeft gevonden moet hij deze selecteren, zodat je bij het afdrukken kunt controleren als dit het juiste is.
En doordat hij hem niet selecteert zal hij dat blad niet afdrukken.

Ben gelukkig al een heel gedeelte verder gekomen, zodat hij in een bepaalde Range zoekt van een werkblad.

 

[Mark xl]

Beste ZZ1,

Werkt het zo?

Sub ZoekZoek()
Dim rZoek As Range
Dim Ws As Worksheet
Dim sZoek As String
Dim sAdres As String
Dim sht1 As String
'automatisch zoeken
Dim j As Long

sht1 = ActiveSheet.Name

Do While j < 10
    
    j = j + 1
    sZoek = Sheets(sht1).Range("G" & 7 + j) 'zoekwaarde instellen
    
    If sZoek <> vbNullString Then   'alleen zoeken als de cel een waarde bevat
    
        For Each Ws In ActiveWorkbook.Sheets
            
            If Ws.Name <> sht1 Then     'naam is ongelijk aan sh1
                'zoek zoekwaarde in ws
                Set rZoek = Ws.Range("A1:K2").Find(What:=sZoek, LookIn:=xlValues, _
                                                    lookat:=xlWhole, MatchCase:=False)
                If Not rZoek Is Nothing Then
                    'zoekwaarde gevonden
                    Ws.Activate       'het blad activeren
                    rZoek.Select      'visueel maken gevonden cel
                    
                    Select Case MsgBox("bedoelt u deze cel?", vbYesNoCancel + vbQuestion)
                        
                        Case vbYes  'print prompt
        
                            If MsgBox("Wilt u dit afdrukken?", vbYesNo, "") = vbYes Then
                                
                                Application.Dialogs(xlDialogPrint).Show
                            
                            End If
        
                        Case vbNo       'doorzoeken
                        
                        Case vbCancel   'gebruiker mogelijkheid bieden de zoekopdracht te annuleren:
                            Exit Do    'annuleren, afbreken
                    
                    End Select
                    
                End If
                    
            End If
            
        Next Ws
    
    End If
    'sht1 weer zichtbaar maken
    If ActiveSheet.Name <> sh1 Then Sheets(sht1).Activate

Loop

MsgBox "Klaar!"

'range object opruimen
Set rZoek = Nothing

End Sub