Sub SplitMergeForm() 
     '
     ' SplitMergeForm Macro
     '
     ' splitter Macro modified to save individual Gift Aid (and Tax) Allocation Forms with
     
     ' information from data source. The filename data must be added to     
     ' the top of the merge letter - see web article.     
    Dim sName As String 
    Dim docName As String 
    Dim Letters As String 
    Dim Counter As Long 
    Dim oDoc As Document 
    Dim oNewDoc As Document 
    Set oDoc = ActiveDocument 
    oDoc.Save      
    Selection.EndKey Unit:=wdStory 
    Letters = Selection.Information(wdActiveEndSectionNumber) 
    Selection.HomeKey Unit:=wdStory 
    Counter = 1 
    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 = "C:\Our Folders\IMAP\Form " & sName & ".doc"          
        oDoc.Sections.First.Range.Cut 
        Set oNewDoc = Documents.Add          
         'Documents are based on the Normal template         
         'To use an alternative template follow the link.
        With Selection 
            .Paste 
            .HomeKey Unit:=wdStory 
            .MoveDown Unit:=wdLine, Count:=1, Extend:=wdExtend 
            .Delete 
        End With 
        oNewDoc.SaveAs FileName:=docName, _ 
        FileFormat:=wdFormatDocument, _ 
        AddToRecentFiles:=False 
        ActiveWindow.Close 
        Counter = Counter + 1 
        Application.ScreenUpdating = True 
    Wend      
    oDoc.Close wdDoNotSaveChanges      
End Sub

Sub SplitMergeForm()
    'Application.ScreenUpdating = False
     '
     ' SplitMergeForm Macro
     '
     ' splitter Macro modified to save individual Gift Aid (and Tax) Allocation Forms with
     
     ' information from data source. The filename data must be added to
     ' the top of the merge letter - see web article.
    Dim sName As String, docName As String
    Dim oDoc As Document, oNewDoc As Document
    Dim Rng As Range
    Dim i As Long, j As Long
    Set oDoc = ActiveDocument
    With oDoc
        j = .Sections.Count - 1
        For i = 1 To j Step 2
            Set Rng = .Sections(i).Range.Paragraphs.Last.Range
            With Rng
                .End = .End - 1
                sName = Replace(.Text, ".", "_")
                .Delete
                .Start = .Sections.First.Range.Start
                docName = "C:\Our Folders\IMAP\Form " & sName & ".doc"
                .MoveEnd wdSection, 2
                .Copy
            End With
            Set oNewDoc = Documents.Add
            With oNewDoc
                With .Range
                    .Paste
                    .ParagraphFormat.SpaceBefore = 0
                    .ParagraphFormat.SpaceAfter = 0
                End With
                .SaveAs2 FileName:=docName, FileFormat:=wdFormatPDF, AddToRecentFiles:=False
                .Close wdDoNotSaveChanges
            End With
        Next
        .Close wdDoNotSaveChanges
    End With
Application.ScreenUpdating = True
End Sub