Sub fff()

Cells(2, 1) = Get_Bold_Only(Cells(1, 1))

End Sub
____________________________________________________________________________________________

Function Get_Bold_Only(rCell As Range)
    Dim lLen As Long, sRes As String, li As Long
    lLen = Len(rCell.Value)
    For li = 1 To lLen
        If rCell.Characters(li, 1).Font.Bold Then
          sRes = sRes & rCell.Characters(li, 1).Text
          iStart = InStr(rCell.Value, sRes)
          iEnd = InStrRev(rCell.Value, sRes)
          iLength = Len(sRes)
        ElseIf iStart > 0 And iLength > 0 Then
          rCell = Left(rCell.Value, iStart) + "<b>" + sRes + "</b>" + Right(rCell.Value, lLen - iStart - iLength)
          li = li + 7
        End If
    Next li
    Get_Bold_Only = rCell