OK, try the following version of the macro. You don't even need to create the output document beforehand - the macro does that for itself.
Code:
Sub Demo()
Application.ScreenUpdating = False
Dim StrTxt As String
StrTxt = ""
With ActiveDocument.Range
With .Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = "FirstN*[0-9]{3}[\+\-][0-9]{3}[\+\-][0-9]{4}*LastN\=*>?"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindStop
.Format = False
.MatchWildcards = True
.Execute
End With
Do While .Find.Found
If InStr(StrTxt, .Duplicate.Text) = 0 Then StrTxt = StrTxt & .Duplicate.Text & "|"
.Collapse wdCollapseEnd
.Find.Execute
Loop
End With
Documents.Add
With ActiveDocument.Range
.InsertAfter Replace(StrTxt, "|", vbCr)
.Characters.Last.Delete
End With
Application.ScreenUpdating = True
End Sub
PS: The phone# format in your latest post differs from what you originally posted. The revised code will handle either format.