Sub Macro1()
Const strFind As String = "Word or phrase" 
Dim oRng As Range, oTargetRng As Range
Dim oSource As Document, oTarget As Document
    Set oSource = ActiveDocument
    Set oTarget = Documents.Add
    Set oRng = oSource.Range
    With oRng.Find
        Do While .Execute(findText:=strFind)
            oRng.Start = oRng.Paragraphs(1).Range.Start
            oRng.End = oRng.Paragraphs(1).Range.End
            'oRng.HighlightColorIndex = wdYellow
            Set oTargetRng = oTarget.Range
            oTargetRng.Collapse 0
            oTargetRng.FormattedText = oRng.FormattedText
            oTargetRng.InsertParagraphAfter
            oRng.Collapse 0
        Loop
    End With
    Set oSource = Nothing: Set oTarget = Nothing
    Set oRng = Nothing: Set oTargetRng = Nothing
End Sub