Option Explicit
Sub TestMe()
Const C_active As String = "Tabelle1"
Const C_B As String = "<b>"
Const C_E As String = "</b>"
Dim uRng As Range, c As Range
Dim cText As String, cLen As Long
Dim x As Long, cb As Long, ce As Long
Dim aText() As Variant
Dim Wst As Worksheet
Dim Wsh As Worksheet: Set Wsh = Sheets(C_active)
On Error Resume Next
Set Wst = Sheets("Tmp")
If Err.Number <> 0 Then
Set Wst = Sheets.Add
ActiveSheet.Name = "Tmp"
End If
On Error GoTo 0
Set uRng = Wsh.UsedRange
Set uRng = uRng.SpecialCells(xlCellTypeConstants)
For Each c In uRng.Cells
If InStr(c.Text, C_B) = False Then
Select Case c.Font.Bold
Case False
Case True
With c.Characters
.Font.Bold = False
cText = .Text
cLen = Len(cText)
.Text = C_B & cText & C_E
End With
c.Characters(Start:=4, Length:=cLen).Font.Bold = True
Debug.Print c.Text
Case Else
End Select
End If
Next c
End Sub