Sub tost7()
Dim Rg1 As Range
For i = 1 To Cells(Rows.Count, 2).End(xlUp).Row
    For j = 1 To ThisWorkbook.Sheets.Count
        If Cells(i, 2).Value = Sheets(j).Name And Sheets(j).Name <> ActiveSheet.Name Then
                Sheets(j).Cells(1, 1).Value = "!"
Set Rg1 = Sheets(j).Rows(3)
Set Rg1 = Rg1.Cells.Find("23", , xlValues, xlWhole)
If Not Rg1 Is Nothing Then Rg1.Interior.ColorIndex = 6
        End If
    Next
Next
End Sub

Interior.ColorIndex = 6

Select

If Not Rg1 Is Nothing Then Rg1.Interior.ColorIndex = 6

If Not Rg1 Is Nothing Then Rg1.Select

Sub tost777()
Dim Rg1 As Range
For i = 1 To Cells(Rows.Count, 2).End(xlUp).Row
    For j = 1 To ThisWorkbook.Sheets.Count
        If Cells(i, 2).Value = Sheets(j).Name And Sheets(j).Name <> ActiveSheet.Name Then
                Sheets(j).Cells(1, 1).Value = "1"
                Sheets(j).Activate
                Set Rg1 = Sheets(j).Rows(3)
                Set Rg1 = Rg1.Cells.Find("45", , xlValues, xlWhole)
                If Not Rg1 Is Nothing Then Rg1.Select
        End If
    Next
Next
End Sub

Sub Поиск()
    Dim sh As Worksheet, rngToFind As Range, strAddress As String
    Dim i, LastRow As Long

With ThisWorkbook
.Worksheets("ITOG").Activate
LastRow = .Worksheets("ITOG").Cells(Rows.Count, 2).End(xlUp).Row
For Each i In .Worksheets("ITOG").Range(Cells(3, 2), Cells(LastRow, 2))
    For Each sh In .Worksheets
        Debug.Print sh.Name
        If Not sh.Name = "ITOG" Then
            Set rngToFind = sh.Rows(3).Find("23")
            strAddress = rngToFind.Address
            Do
                Set rngToFind = sh.Rows(3).FindNext(rngToFind)
                rngToFind.Interior.Color = vbGreen
            Loop While rngToFind.Address <> strAddress
        End If
    Next sh
Next i
End With
End Sub

Loop While rngToFind.Address <> strAddress

strAddress = rngToFind.Address