The following macro copies text one page at a time and saves that text in a new document. The macro uses the pre-defined bookmark "\page" and the document's built-in property of "number of pages."
Sub BreakOnPage()
' Used to set criteria for moving through the document by page.
Application.Browser.Target = wdBrowsePage
For i = 1 To ActiveDocument.BuiltInDocumentProperties("Number of Pages")
'Select and copy the text to the clipboard.
ActiveDocument.Bookmarks("\page").Range.Copy
' Open new document to paste the content of the clipboard into.
Documents.Add
Selection.Paste
' Removes the break that is copied at the end of the page, if any.
Selection.TypeBackspace
ChangeFileOpenDirectory "C:\"
DocNum = DocNum + 1
ActiveDocument.SaveAs FileName:="test_" & DocNum & ".doc"
ActiveDocument.Close
' Move the selection to the next page in the document.
Application.Browser.Next
Next i
ActiveDocument.Close savechanges:=wdDoNotSaveChanges
End Sub
The following macro copies text one section at a time and saves that text in a new document. The macro uses the pre-defined bookmark "\section" to create the new document. This macro is useful for breaking up a mail-merge "Merge to New Document" file.
Sub BreakOnSection()
' Used to set criteria for moving through the document by section.
Application.Browser.Target = wdBrowseSection
'A mail merge document ends with a section break next page.
'Subtracting one from the section count stop error message.
For i = 1 To ((ActiveDocument.Sections.Count) - 1)
'Note: If a document does not end with a section break,
'substitute the following line of code for the one above:
'For I = 1 To ActiveDocument.Sections.Count
'Select and copy the section text to the clipboard.
ActiveDocument.Bookmarks("\Section").Range.Copy
'Create a new document to paste text from clipboard.
Documents.Add
Selection.Paste
' Removes the break that is copied at the end of the section, if any.
Selection.MoveUp Unit:=wdLine, Count:=1, Extend:=wdExtend
Selection.Delete Unit:=wdCharacter, Count:=1
ChangeFileOpenDirectory "C:\"
DocNum = DocNum + 1
ActiveDocument.SaveAs FileName:="test_" & DocNum & ".doc"
ActiveDocument.Close
' Move the selection to the next section in the document.
Application.Browser.Next
Next i
ActiveDocument.Close savechanges:=wdDoNotSaveChanges
End Sub
When you use this code to select and copy the text content of the document, the header and footer are not retained. Styles, fonts, and layout may change if the main file and the new document are from different templates, but direct formatting is maintained.