Sub start()
cb = Len(ActiveCell.Value)
neu = ActiveCell.Value
For x = 1 To cb
With ActiveCell.Characters(Start:=x, Length:=1).Font
If .Underline = xlUnderlineStyleSingle Then
' MsgBox ("unterstrichen")
neu = Left(neu, x - 1) & "'" & Right(neu, Len(neu) - x + 1)
Else
' MsgBox ("nicht unterstrichen")
End If
End With
Next
ActiveCell.Value = neu
End Sub