Split document

[KirstieA]

Hi all,

I have a 300 page document that i want to save in 100 3 page documents, so
every 3 pages is a separate file.

I have the following macro that does it for each individual page but don't
know how to change it for every 3 pages.

--------------------------------------------------------

Sub SplitByPage()

Dim mask As String
Letters = ActiveDocument.Bookmarks("\page").Range
mask = "ddMMyy"

Selection.HomeKey Unit:=wdStory
Counter = 1
While Counter < Letters
Application.ScreenUpdating = False
sName = "LA Notification - Appointment of Carer"
Docname = "C:\My Documents\Test\Merge\" _
& sName & " " & LTrim$(Str$(Counter))
On Error GoTo oops:
ActiveDocument.Bookmarks("\page").Range.Cut
Documents.Add
With Selection
.Paste
.EndKey Unit:=wdStory
.MoveLeft Unit:=wdCharacter, Count:=1
.Delete Unit:=wdCharacter, Count:=1
End With
ActiveDocument.SaveAs FileName:=Docname, _
FileFormat:=wdFormatDocument
ActiveWindow.Close
Counter = Counter + 1
Application.ScreenUpdating = True
Wend
oops:
End Sub

 

[Doug Robbins - Word MVP]

The following, run when the 300 page document is the activedocument should
do what you want:

Dim i As Long, j As Long, Source As Document, Target As Document, myrange As
Range
Set Source = ActiveDocument
Selection.HomeKey Unit:=wdStory
For i = 1 To 100
Set Target = Documents.Add
Source.Activate
j = 1
For j = 1 To 3
Set myrange = Selection.Bookmarks("\page").Range
Target.Range.InsertAfter myrange
myrange.Delete
Next j
Target.SaveAs "C:\test\Document" & i
Target.Close
Next i

If however it happens that each of the 3 pages in the 300 page document are
separated by a Section break, as happens when a formletter type mail merge
is executed to a new document, then you could use:

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
Letter.End=Letter.End-1
Set Target = Documents.Add
Target.Range=Letter
Target.SaveAs FileName:="Letter" & i
Target.Close
Next i


--
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