Sub Demo()
Application.ScreenUpdating = False
Dim i As Long, StrFnd As String
With ActiveDocument
  For i = .Paragraphs.Count To 1 Step -1
    StrFnd = .Paragraphs(i).Range.Text
    With .Range.Find
      .ClearFormatting
      .Replacement.ClearFormatting
      .Text = StrFnd
      .Replacement.Text = ""
      .Format = False
      .Forward = True
      .Wrap = wdFindContinue
      .MatchAllWordForms = False
      .MatchCase = False
      .MatchWholeWord = True
      .MatchWildcards = False
      .Execute Replace:=wdReplaceAll
    End With
    .Range.InsertAfter StrFnd
  Next
End With
Application.ScreenUpdating = True
End Sub