I am unable to replicate the behaviour you describe. Perhaps you could attach the actual document exhibiting the behaviour to a post (delete anything sensitive). You do this via the paperclip symbol on the 'Go Advanced' tab at the bottom of this screen.
As for the codes you're using, I'd have been inclined to used something closer to standard HTML:
Code:
Sub aabFettKursivQuelldok()
Application.ScreenUpdating = False
With ActiveDocument.Range.Find
.ClearFormatting
.Replacement.ClearFormatting
.Format = True
.Forward = True
.MatchWildcards = True
.Wrap = wdFindContinue
.Font.Underline = True
.Text = ""
.Replacement.Text = "<u>^&</u>"
.Execute Replace:=wdReplaceAll
.ClearFormatting
.Highlight = True
.Replacement.Text = "<h>^&</h>"
.Execute Replace:=wdReplaceAll
.ClearFormatting
.Font.Bold = True
.Replacement.Text = "<b>^&</b>"
.Execute Replace:=wdReplaceAll
.ClearFormatting
.Font.Italic = True
.Replacement.Text = "<i>^&</i>"
.Execute Replace:=wdReplaceAll
End With
Application.ScreenUpdating = True
End Sub
Code:
Sub aabFettKursivZieldok()
Application.ScreenUpdating = False
With ActiveDocument.Range.Find
.ClearFormatting
.Replacement.ClearFormatting
.Format = True
.Forward = True
.MatchWildcards = True
.Wrap = wdFindContinue
.Replacement.Text = "\1"
.Text = "\<u\>(*)\</u\>"
.Replacement.Font.Underline = True
.Execute Replace:=wdReplaceAll
.Replacement.ClearFormatting
.Text = "\<h\>(*)\</h\>"
.Replacement.Highlight = True
.Execute Replace:=wdReplaceAll
.Replacement.ClearFormatting
.Text = "\<b\>(*)\</b\>"
.Replacement.Font.Bold = True
.Execute Replace:=wdReplaceAll
.Replacement.ClearFormatting
.Text = "\<i\>(*)\</i\>"
.Replacement.Font.Italic = True
.Execute Replace:=wdReplaceAll
End With
Application.ScreenUpdating = True
End Sub
Note that the first macro above also doesn't specify the 'find' text. That way, multiple consecutive words in a given format need only have a single set of each kind of tagging. As coded, that macro will also insert the </i>, etc. after any formatted paragraph mark. To exclude the paragraph marks, change:
.Text = ""
to:
.Text = "[!^13]{1,}"