This is a later version of my macro than the one on Graham's site that I
think overcomes the problem that you mention.

Sub splitter()

' splitter Macro

' Macro created by Doug Robbins to save each letter created by a mailmerge
as a separate file.

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

End Sub

If you do not need to save the documents individually, but just want to
print the individually, use the following:

Dim i As Long
With ActiveDocument
   For i = 1 To .Sections.Count
        .PrintOut Range:=wdPrintFromTo, From:="s" & i, To:="s" & i
   Next i
End With

Thanks for this. Have tried it out and it works, however, it removes all the
formatting from the doc (it's laid out in tables). The original macro I was
using is the one below - this works perfectly apart from adding that extra
page at the end are there any solutions or maods that I can make to this for
removing the extra page. Thanks again for all the help!

Best

Mark
---------------------------------------------------------------------

Sub SplitMerge()
' splitter Macro
' Macro created 16-08-98 by Doug Robbins to save each letter created by a
' mailmerge as a separate file.
' with modifications by Graham Mayor 16-06-03

Dim Title As String
Dim Default As String
Dim MyText As String
Dim MyName As Variant
Dim MyPath As String

Selection.EndKey Unit:=wdStory
Letters = Selection.Information(wdActiveEndSectionNumber)
Selection.HomeKey Unit:=wdStory
Counter = 1
MyPath = "U:\1A_currentFFprojects\Cohort\COHORTmerge"
Default = "Merged"
MyText = "Enter a filename. Long filenames may be used."
Title = "File Name"

MyName = InputBox(MyText, Title, Default)
  If MyName = "" Then
  End
  End If

While Counter < Letters
  Application.ScreenUpdating = False
  Docname = MyPath & LTrim$(Str$(Counter)) & " " & MyName

  ActiveDocument.Sections.First.Range.Cut
  Documents.Add
  Selection.Paste
  ActiveDocument.SaveAs FileName:=Docname
  ActiveWindow.Close
  Counter = Counter + 1
  Application.ScreenUpdating = True
Wend

End Sub

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