Sub HighlightTagger()
  Dim aRng As Range
  Set aRng = ActiveDocument.Range
  With aRng.Find
    .Text = ""
    .ClearFormatting
    .Replacement.ClearFormatting
    .MatchWildcards = False
    .Forward = True
    .Wrap = wdFindStop
    .Highlight = True
    Do While .Execute
      Select Case aRng.HighlightColorIndex
        Case wdYellow
          aRng.InsertBefore "[Color: Yellow]"
        Case wdBlue
          aRng.InsertBefore "[Color: Blue]"
        Case Else
          aRng.InsertBefore "[Color: Other]"
      End Select
      If aRng.Characters.Last = vbCr Then
        aRng.Characters.Last.InsertBefore "[/Color]"
      Else
        aRng.InsertAfter "[/Color]"
      End If
      aRng.Collapse Direction:=wdCollapseEnd
    Loop
  End With
End Sub