Sub BoldText()
Application.ScreenUpdating = False
With ActiveDocument
  With .Range
    .InsertBefore vbCr
    With .Find
      .ClearFormatting
      .Replacement.ClearFormatting
      .Forward = True
      .Format = False
      .Wrap = wdFindStop
      .MatchWildcards = True
      .Text = "^13[!^13]@[^t:]"
    End With
    Do While .Find.Execute
      .Start = .Start + 1
      .End = .End - 1
      .Font.Bold = True
      .Characters.Last.Next = vbTab
      .Collapse wdCollapseEnd
    Loop
  End With
  .Range.Characters.First.Delete
End With
Application.ScreenUpdating = True
End Sub