Sub ertert()
Dim s$, r As Range, i&, j&
s = Range("E3").Value: j = Len(s)
With Range("C1", Cells(Rows.Count, 3).End(xlUp))
      .Font.Bold = False
      For Each r In .Cells
          i = InStr(r, s)
          If i Then r.Characters(i, j).Font.Bold = True
      Next
End With
End Sub

Option Explicit
Private mavPunct()

Sub DoIt()
       mavPunct = Array(" ", ",", ".", ";", ":", "!")
       ' символы, к-рые могут идти после искомого слова _
         нужно, чтобы искть ТОЛЬКО целые слова

       Dim c As Range
       For Each c In Selection
           BoldWord c, "украл"
       Next c
End Sub

'=================================================================
Sub BoldWord(rngIn As Range, sWord As String)
       Dim lPos As Long
       lPos = 1

       Dim lLen As Long
       lLen = Len(sWord)

       Dim sLS As String
       Do
           lPos = InStr(lPos, rngIn.Value, sWord)
           If lPos = 0 Then Exit Do

           sLS = Mid$(rngIn.Value, lPos + lLen, 1)
           If bSymbolIsValid(sLS) Then
               rngIn.Characters(lPos, lLen).Font.Bold = True
           End If

           lPos = lPos + lLen
       Loop
End Sub

Function bSymbolIsValid(sS As String) As Boolean
       Dim i As Integer
       For i = LBound(mavPunct) To UBound(mavPunct)
           If sS = mavPunct(i) Then
               bSymbolIsValid = True
               Exit For
           End If
       Next i
End Function
'=================================================================