How do you search through multiple sheets to find a specific value?

Hi

I was wondering if somebody could help me with some code that I have adapted for searching for a specific name within a worksheet and if found then copying and pasting cell values around the found name into specific cells. My problem is that I would like to know how to search through all the sheets within the workbook. In my case there will only ever be 3 worksheets (sheets2,3 and 4) to search in, sheet1 will be for the copied data.

Here is a bit more detail:
The variable can either be on sheets2,sheets3 or sheets4 and will either appear once (throughout the workbook) or not at all, if not found then a message box saying "I could not find variable” pops up or if it found specific cells around the variable are copied to sheet1 into specific cells (always the same cells)
This my code :

Option Explicit

Sub PlayMacro()

  Dim Prompt As String
  Dim RetValue As String
  Dim Rng As Range
  Dim RowCrnt As Long
  Dim ColCrnt As Long
  Dim wksht As Long
  Prompt = ""


 With Sheets("Sheet2").Select   ‘it is here I am unsure how to code for multiple sheets, I need to select 3 and 4 as well
  
    Do While True

      RetValue = InputBox(Prompt & "Give me a value to look for")
   
      If RetValue = "" Then
        Exit Do
      End If

     
      Set Rng = .Columns("A:Z").Find(What:=RetValue, After:=.Range("A1"), LookIn:=xlFormulas, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)

                If Rng Is Nothing Then
                  
                Prompt = "I could not find """ & RetValue & """"
      Else
        
        ColCrnt = Rng.Column
        RowCrnt = Rng.Row

        Prompt = "I found """ & RetValue & """ on row " & RowCrnt 
        Sheets("Sheet2").Cells(RowCrnt, ColCrnt - 1).Copy
        Sheets("Sheet1").Range("A1").PasteSpecial
        Sheets("Sheet2").Cells(RowCrnt, ColCrnt - 2).Copy
        Sheets("Sheet1").Range("A2").PasteSpecial
        Sheets("Sheet2").Cells(RowCrnt, ColCrnt + 1).Copy
        Sheets("Sheet1").Range("A3").PasteSpecial
        Sheets("Sheet2").Cells(RowCrnt, ColCrnt + 2).Copy
        Sheets("Sheet1").Range("A4").PasteSpecial
        
        
        Application.CutCopyMode = False
    
 
      End If
      
      Prompt = Prompt & vbLf
    Loop

  End With

End Sub

Thanks for looking

See if this works:

Sub PlayMacro()

Dim Prompt As String
Dim RetValue As String
Dim Rng As Range
Dim RowCrnt As Long
Dim ColCrnt As Long
Dim wksht As Worksheet

Prompt = ""

RetValue = InputBox(Prompt & "Give me a value to look for")
If RetValue = "" Then
  Exit Sub
End If

For Each wksht In Worksheets
    If wksht.Name <> "Sheet1" Then
        With wksht
            Set Rng = .Columns("A:Z").Find(What:=RetValue, After:=.Range("A1"), LookIn:=xlFormulas, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
            If Rng Is Nothing Then
                GoTo line1
            Else
                ColCrnt = Rng.Column
                RowCrnt = Rng.Row
                Prompt = "I found """ & RetValue & """ on row " & RowCrnt
                .Cells(RowCrnt, ColCrnt - 1).Copy
                Sheets("Sheet1").Range("A1").PasteSpecial
                .Cells(RowCrnt, ColCrnt - 2).Copy
                Sheets("Sheet1").Range("A2").PasteSpecial
                .Cells(RowCrnt, ColCrnt + 1).Copy
                Sheets("Sheet1").Range("A3").PasteSpecial
                .Cells(RowCrnt, ColCrnt + 2).Copy
                Sheets("Sheet1").Range("A4").PasteSpecial
                Application.CutCopyMode = False
                MsgBox Prompt
                Exit Sub
            End If
        End With
    End If
line1:
Next wksht

MsgBox "I could not find """ & RetValue & """"

End Sub

I generally loop through the sheets in book:

Option Explicit

Sub PlayMacro()

  Dim Prompt As String
  Dim RetValue As String
  Dim Rng As Range
  Dim RowCrnt As Long
  Dim ColCrnt As Long
  Dim wksht As Long
  Dim wshLoop As WorkSheet
  Dim lCopyLoop As Long
  Prompt = ""
  
  Do While True

    RetValue = InputBox(Prompt & "Give me a value to look for")
  
    If RetValue = "" Then
      Exit Sub
    End If


    For Each wshLoop In ActiveWorkbook.Sheets

      If wshLoop.Name <> "Sheet1" Then


        With wshLoop
      
          Set Rng = .Columns("A:Z").Find(What:=RetValue, After:=.Range("A1"), LookIn:=xlFormulas, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext,MatchCase:=False, SearchFormat:=False)

          If Not Rng Is Nothing Then
                        
            ColCrnt = Rng.Column
            RowCrnt = Rng.Row

            Prompt = "I found """ & RetValue & """ on row " & RowCrnt 
           .Cells(RowCrnt, ColCrnt - 1).Copy Destination:=Sheets("Sheet1").Range("A1")
           .Cells(RowCrnt, ColCrnt - 2).Copy Destination:=Sheets("Sheet1").Range("A2")
           .Cells(RowCrnt, ColCrnt + 1).Copy Destination:=Sheets("Sheet1").Range("A3")
           .Cells(RowCrnt, ColCrnt + 2).Copy Destination:=Sheets("Sheet1").Range("A4")

         End If
      
         Prompt = Prompt & vbLf

    End With
    
  End If
Next wshLoop

Loop

End Sub

Untested, so may take a little bug-fixing.

Thank you StephenR and Andrew-R. I have tested both sets of code and both work really well. Thanks for helping me out, I can now continue