[Doug Robbins - Word MVP]

In the following macro, the blank page is eliminated by converting the
section break to a continuous section break

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

"owen" wrote in message
...
I combined parts and modified the SplitMerge macros on site hosted by
gmayor
(many thanks to graham and Doug Robbins); to name the split docs with
unique
name from mergfield in doc and save to selected location. It works fine
except it creates an extra blank page with each letter, does any one know
what I need to change or add to keep the extra page from being created, or
to
automatically delete it.

thanks,
owen

Here is the Macro as written:

Sub SplitMergeDocWithName()

' SplitMergeDoc Macro modified to save individual letters with
' information from data source. The filename data must be added to
' the top of the merge letter and must be unique.

Dim Default As String
Dim MyPath As String
Selection.EndKey Unit:=wdStory
Letters = Selection.Information(wdActiveEndSectionNumber)
Selection.HomeKey Unit:=wdStory
Counter = 1
Default = ""
Title = "Save To"
MyText = "Enter File Location"
MyPath = InputBox(MyText, Title, Default)
If MyPath = "" Then
End
End If
While Counter Letters
Application.ScreenUpdating = False
With Selection
.HomeKey Unit:=wdStory
.EndKey Unit:=wdLine, Extend:=wdExtend
.MoveLeft Unit:=wdCharacter, Count:=1, Extend:=wdExtend
End With
sName = Selection
Docname = MyPath & sName & ".doc"
ActiveDocument.Sections.First.Range.Cut
Documents.Add
With Selection
.Paste
.HomeKey Unit:=wdStory
.MoveDown Unit:=wdLine, Count:=1, Extend:=wdExtend
.Delete
End With
ActiveDocument.SaveAs FileName:=Docname, FileFormat:=wdFormatDocument
ActiveWindow.Close
Counter = Counter + 1
Application.ScreenUpdating = True
Wend


End Sub