Try:
Code:
Sub Demo()
Application.ScreenUpdating = False
With ActiveDocument.Range
With .Find
.ClearFormatting
.Replacement.ClearFormatting
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchWildcards = True
.Text = "[^13]{1,}"
.Replacement.Text = " "
.Execute Replace:=wdReplaceAll
.Text = "[ ]{2,}"
.Replacement.Text = " "
.Execute Replace:=wdReplaceAll
.Text = "(<[0-9]{1,}[!0-9]@)([A-Z]\))"
.Replacement.Text = "^p\1^p\2"
.Execute Replace:=wdReplaceAll
.Text = "(<[0-9]{1,}[!0-9]@) ^13"
.Replacement.Text = "\1^l"
.Replacement.Style = "Strong"
.Execute Replace:=wdReplaceAll
End With
End With
Application.ScreenUpdating = True
End Sub