Pages (particularly a multiple number of pages) are not a very good thing to
be using as a basis. If there was some other way of determining the split
point, such as a section break, the result would be more repeatable. You
could modify the following code to do it:
Sub splitter()
'
' splitter Macro
' Macro created 16-08-98 by Doug Robbins to save each page of a document
' as a separate file with the name Page#.DOC
'
Dim Counter As Long, Source As Document, Target As Document
Set Source = ActiveDocument
Selection.HomeKey Unit:=wdStory
Pages = Source.BuiltInDocumentProperties(wdPropertyPages)
Counter = 0
While Counter < Pages
Counter = Counter + 1
DocName = "Page" & Format(Counter)
Source.Bookmarks("\Page").Range.Cut
Set Target = Documents.Add
Target.Range.Paste
Target.SaveAs FileName:=DocName
Target.Close
Wend
End Sub
The following is an untested modification of the above that might do it
Dim Counter As Long, Source As Document, Target As Document
Dim i as Long, mypage as range
Set Source = ActiveDocument
Selection.HomeKey Unit:=wdStory
Pages = Source.BuiltInDocumentProperties(wdPropertyPages)
Counter = 0
While Counter < Pages
Counter = Counter + 10
DocName = "Page" & Format(Counter - 9)
Source.Bookmarks("\Page").Range.Cut
Set Target = Documents.Add
Target.Range.Paste
For i = 1 to 9
Set mypage = Source.Bookmarks("\Page").Range
Target.Range.InsertAfter mypage
Source.Bookmarks("\Page").Range.Cut
Next i
Target.SaveAs FileName:=DocName
Target.Close
Wend
It should number the separate files as Page1, Page11, Page21, etc.
If you had section breaks, you could use:
Sub splitter()
' splitter Macro
' Macro created by Doug Robbins to save each letter created by a mailmerge
' as a separate file, retaining the header and footer information.
Dim i As Long, Source As Document, Target As Document, Letter As Range
Set Source = ActiveDocument
For i = 1 To Source.Sections.Count
Set Letter = Source.Sections(i).Range
Set Target = Documents.Add
Target.Range = Letter
Target.Sections(2).PageSetup.SectionStart = wdSectionContinuous
Target.SaveAs FileName:="Letter" & i
Target.Close
Next i
End Sub
--
Hope this helps.
Please reply to the newsgroup unless you wish to avail yourself of my
services on a paid consulting basis.
Doug Robbins - Word MVP
