Option Explicit
Sub Test()
Dim R As Worksheet, ws As Worksheet
Dim k%
Dim Fnd As Range
k = 6
Set R = Sheets("result")
    If R.Range("A5").CurrentRegion.Rows.Count > 1 Then
       R.Range("A5").CurrentRegion.Offset(1). _
       Resize(R.Range("A5").CurrentRegion. _
       Rows.Count - 1).ClearContents
    End If
    
    If R.Range("A2") = vbNullString Then
    MsgBox "Type in cell A2 a value to find it"
    Exit Sub
    End If
For Each ws In ThisWorkbook.Sheets
If Not ws.Name = R.Name Then
   With ws
    Set Fnd = .UsedRange.Find(R.Range("A2"), lookat:=1)
       If Not Fnd Is Nothing Then
            With R.Cells(k, 1)
                .Value = ws.Name
                .Offset(, 1) = Fnd.Address
                .Offset(, 2) = Fnd
               k = k + 1
             End With
        End If
   End With
End If
Next ws
If k = 6 Then MsgBox "I Can't Find  " & _
 """" & R.Range("A2") & """" & "  Any Where"
End Sub

Option Explicit
Sub New_Test()
Dim R As Worksheet, ws As Worksheet
Dim k%, Adr1$, Adr2$
Dim Fnd As Range, mot
Dim arr(), t%, St$
k = 6

Set R = Sheets("result")
mot = R.Range("A2")
    If R.Range("A5").CurrentRegion.Rows.Count > 1 Then
       R.Range("A5").CurrentRegion.Offset(1). _
       Resize(R.Range("A5").CurrentRegion. _
       Rows.Count - 1).ClearContents
    End If
    
    If mot = vbNullString Then
      MsgBox "Type in cell A2 a value to find it"
      Exit Sub
    End If
For Each ws In ThisWorkbook.Sheets
If Not ws.Name = R.Name Then
   With ws
        Set Fnd = .UsedRange.Find(mot, lookat:=1)
          If Fnd Is Nothing Then GoTo Next_sheet
           
            Adr1 = Fnd.Address: Adr2 = Adr1
          Do
            If mot <> Fnd Then
             ReDim Preserve arr(t)
              arr(t) = ws.Name & " : " & Fnd.Address
              t = t + 1
            End If
            
              If mot = Fnd Then
                 With R.Cells(k, 1)
                     .Value = ws.Name
                     .Offset(, 1) = Adr2
                     .Offset(, 2) = Fnd
                    k = k + 1
                  End With
              End If
               Set Fnd = .UsedRange.FindNext(Fnd)
               Adr2 = Fnd.Address
              If Adr2 = Adr1 Then Exit Do
          
          Loop
   End With
End If

Next_sheet:
Next ws
If k = 6 Then MsgBox "I Can't Find  " & _
 """" & R.Range("A2") & """" & "  Any Where"
 If t > 0 Then
   For k = 0 To UBound(arr)
      St = St & arr(k) & Chr(10)
   Next
    St = "Case Insensitive in :" & Chr(10) & St
    MsgBox St
 End If
End Sub