Extract Based on Criteria

[Snowshoestu]

I was trying to merge to "found" strings of code to Find a string and then extract those pages to a new Document. I have the following but it isn't working correctly. Any suggestions would be appreciated.

Sub New_Doc()
Dim sWord As String
sWord = InputBox("Enter term to find", "Print pages")
With Selection
.HomeKey wdStory
With .Find
.ClearFormatting
.Replacement.ClearFormatting
While .Execute(findText:=sWord)
Selection.Extend
Application.Browser.Next
' copies selected page
Selection.Copy
' creates a new document and saves it
Documents.Add DocumentType:=wdNewBlankDocument
Selection.PasteAndFormat (wdPasteDefault)
ActiveDocument.SaveAs Filename:="NewDoc.doc"
Wend
End With
End With
End Sub

[Snowshoestu]

My apologies, I am attempting to extract the pages from a search to a seperate document.

[Snowshoestu]

I to found this very difficult. At least I am not the only one.