Microsoft Word macro to merge the current document and split each section into individual files

MergeAndBreakIntoFiles.macro

Sub MergeAndBreakIntoFiles()
'
' Merges the current document and splits each section into individual files
'
'
    With ActiveDocument.MailMerge
        .Destination = wdSendToNewDocument
        .SuppressBlankLines = True
        .DataSource.ActiveRecord = wdFirstRecord
        .Execute Pause:=False
    End With

    'A mailmerge document ends with a section break next page.
    'Subtracting one from the section count stop error message.
    For i = 1 To ((ActiveDocument.Sections.Count) - 1)
        'Select and copy the section text to the clipboard
        ActiveDocument.Sections(i).Range.Copy
 
        'Create a new document to paste text from clipboard.
        With Documents.Add
            'Removes the break that is copied at the end of the section, if any.
            Selection.MoveUp Unit:=wdLine, Count:=1, Extend:=wdExtend
            Selection.Delete Unit:=wdCharacter, Count:=1

            Selection.Paste

            docName = .Sentences(1) & ".doc"

           .SaveAs fileName:=CleanString(docName), AddToRecentFiles:=False
           .Close
        End With
    Next i

    ActiveDocument.Close savechanges:=wdDoNotSaveChanges
End Sub