Sub Find_n_Highlight()
S2.Activate 'активируем нужный лист

Set whereImLooking = Worksheets("S2").Range("X2:X" & Worksheets("S2").Cells(Rows.Count, "X").End(xlUp).Row) ' переход на рабочий лист

On Error Resume Next: Err.Clear
Dim ra As Range, cell As Range, res, txt$, v, pos&
res = InputBox("Введите текст который нужно подсветить", "поиск", " ")
If VarType(res) = vbBoolean Then Exit Sub ' нажата кнопка отмены
txt$ = Trim(res): If Len(txt) = 0 Then Exit Sub ' текст не введен или состоит из пробелов

Set ra = Range([X2], Range("X" & Rows.Count).End(xlUp)) ' диапозон для поиска
Application.ScreenUpdating = False
ra.Font.Color = 0: ra.Font.Bold = 0 ' сброс цветового выделения

For Each cell In ra.Cells ' разбиваем текс ячейки на части
pos = 1
If cell.Text Like "*" & txt & "*" Then
arr = Split(cell.Text, txt, , vbTextCompare) перебираем все ячейки
If UBound(arr) > 0 Then ' 'если подстройка найдена

For Each v In arr ' перебираем все нахождения
pos = pos + Len(v) ' начальная позиция
With cell.Characters(pos, Len(txt))
.Font.ColorIndex = 3 ' выделяем цветом
.Font.Bold = True ' выделяем жирным

End With
pos = pos + Len(txt)
Next v
End If
End If
End If
Next cell

End Sub