Sub Macro1()
Dim oTarget As Document
Dim oDoc As Document
Dim oRng As Range, oEnd As Range
    Set oDoc = ActiveDocument
    Set oTarget = Documents.Add
    Set oRng = oDoc.Range

    With oRng.Find
        .Font.Color = RGB(128, 0, 128)
        .Text = ""
        Do While .Execute
            oRng.MoveEndUntil Chr(13)
            oRng.End = oRng.End + 1
            oRng.MoveEndUntil Chr(13)

            Set oEnd = oTarget.Range
            oEnd.Collapse 0
            oEnd.FormattedText = oRng.FormattedText
            oEnd.Collapse 0
            oEnd.InsertParagraphAfter
            oRng.Collapse 0
        Loop
    End With
    oTarget.Activate
lbl_Exit:
    Set oTarget = Nothing
    Set oDoc = Nothing
    Set oRng = Nothing
    Set oEnd = Nothing
    Exit Sub
End Sub