Sub Demo()
Dim i As Long
Application.ScreenUpdating = False
With ActiveDocument.Range
  With .Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Text = "(<[A-Za-z]@>)([!^13]@)<\1>"
    .Replacement.Text = "\1\2"
    .Format = False
    .Forward = True
    .Wrap = wdFindContinue
    .MatchWildcards = True
  End With
  Do While i <> Len(.Text)
    i = Len(.Text)
    .Find.Execute Replace:=wdReplaceAll
  Loop
  With .Find
    .Text = "[ ]{2,}"
    .Replacement.Text = " "
    .Execute Replace:=wdReplaceAll
  End With
End With
Application.ScreenUpdating = True
End Sub