Sub ShowAdrCells()
    Dim TxtForFind As String, RngForFind As Range, i As Integer, c As Range
    For Each c In Intersect(Sheets("Исходный").UsedRange, Sheets("Исходный").Columns(6)).Cells
        If c.Value <> "" Then
            TxtForFind = c.Value
            For i = 2 To Sheets.Count
                With ThisWorkbook.Sheets(i).Columns("C")
                    Set RngForFind = .Find(TxtForFind, LookIn:=xlValues, LookAt:=xlWhole)
                    If Not RngForFind Is Nothing Then
                        c.Interior.ColorIndex = i + 2
                        ' MsgBox "Искомое значение найдено в ячейке: " & RngForFind.Address(0, 0) & " на листе: " & Sheets(i).Name, 64, "Для сведения..."
                        Exit For
                    End If
                End With
            Next
        End If
    Next
End Sub

Sub ShowAdrCells()
Dim TxtForFind As String, RngForFind As Range, FirstAddress As String, i As Integer
Dim rowLast As Integer, j%
Dim arrColor(1 To 4) As Long

arrColor(1) = 5296274
arrColor(2) = 15773696
arrColor(3) = 49407
arrColor(4) = 12566463

rowLast = ThisWorkbook.Worksheets("Исходный").Cells(Rows.Count, 6).End(xlUp).Row
For j = 1 To rowLast
TxtForFind = ThisWorkbook.Worksheets("Исходный").Cells(j, 6)
For i = 2 To Sheets.Count
With ThisWorkbook.Sheets(i).Columns("C")
Set RngForFind = .Find(TxtForFind, LookIn:=xlValues, LookAt:=xlWhole)
If Not RngForFind Is Nothing Then
ThisWorkbook.Worksheets("Исходный").Cells(j, 6).Interior.Color = arrColor(i - 1)
FirstAddress = RngForFind.Address
Do
MsgBox "Искомое значение найдено в ячейке: " & RngForFind.Address(0, 0) & " на листе: " & Sheets(i).Name, 64, "Для сведения..."

Loop While RngForFind.Address <> FirstAddress
End If
End With
Next i
Next j
End Sub

Sub ShowAdrCells()
Dim TxtForFind As String, RngForFind As Range, FirstAddress As String, i As Integer
Dim rowLast As Integer, j%, k%
Dim arrColor(1 To 4) As Long

arrColor(1) = 5296274
arrColor(2) = 15773696
arrColor(3) = 49407
arrColor(4) = 12566463

rowLast = ThisWorkbook.Worksheets("Исходный").Cells(Rows.Count, 6).End(xlUp).Row
For j = 1 To rowLast
TxtForFind = ThisWorkbook.Worksheets("Исходный").Cells(j, 6)
k = 0
For i = 2 To Sheets.Count
With ThisWorkbook.Sheets(i).Columns("C")
Set RngForFind = .Find(TxtForFind, LookIn:=xlValues, LookAt:=xlWhole)
If Not RngForFind Is Nothing Then
ThisWorkbook.Worksheets("Исходный").Cells(j, 6 + k * 2).Interior.Color = arrColor(i - 1)
ThisWorkbook.Worksheets("Исходный").Cells(j, 7 + k * 2).Value = ThisWorkbook.Sheets(i).Name
ThisWorkbook.Worksheets("Исходный").Cells(j, 6 + k * 2).Value = TxtForFind
k = k + 1
End If
End With
Next i
Next j
End Sub