Word Macro for find all / select entire page / cut to new document

[Dimmthewitted]

Hello,

I am working on a VB script to scan a large document of company statements for certain criteria and then pull each page out and paste it in a new document. I am not a VB coder and got in a bit over my head with deadlines looming.

Right now the code copies and pastes a page into a new document, but not the search page just the current page. Any advice would be greatly appreciated.

Sub RemoveMultiPageStatements()


' create another doc to copy to / label docs

Dim docA As Document
Set docA = ActiveDocument
Documents.Add Template:="Normal", NewTemplate:=False, DocumentType:=0
ActiveDocument.SaveAs2 FileName:= _
"DocB.docx", FileFormat:= _
wdFormatXMLDocument, LockComments:=False, Password:="", AddToRecentFiles _
:=True, WritePassword:="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts _
:=False, SaveNativePictureFormat:=False, SaveFormsData:=False, _
SaveAsAOCELetter:=False, CompatibilityMode:=14
Dim docB As Document
Set docB = ActiveDocument
docA.Activate

Dim SearchTerm As String
SearchTerm = "Page 1 of 2"


' \page selects the entire page


Selection.GoTo What:=wdGoToBookmark, Name:="\page"
Selection.Find.ClearFormatting
With Selection.Find
.Text = SearchTerm
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchWildcards = True
.Execute
End With
If Selection.Find.Found Then
Selection.GoTo What:=wdGoToBookmark, Name:="\page"
Selection.Cut
docB.Activate
Selection.Paste
docA.Activate

'remove page 2
Selection.GoTo What:=wdGoToBookmark, Name:="\page"
Selection.Cut
docB.Activate
Selection.Paste
docA.Activate


End If





End Sub

 

[Macropod]

For a demonstration of how to process content on multiple pages using Find, see the code I've posted at: Find all occurences on the one page - Microsoft Answers