@אוריי תדביק את הקוד הבא במודול:
Public Sub SplitActiveDocumentBySection()
Dim outputDoc As Document
Dim sectionCount As Integer
Dim currentSection As Section
Dim baseFileName As String
sectionCount = ActiveDocument.Sections.Count
If MsgBox("Would you like to split this document into " & sectionCount & " sections?", vbYesNo) <> vbYes Then Exit Sub
baseFileName = CreateObject("Scripting.FileSystemObject").GetBaseName(ActiveDocument.Name)
For Each currentSection In ActiveDocument.Sections
Application.StatusBar = "Saving section " & currentSection.Index & " of " & sectionCount & "..."
currentSection.Range.Copy
Set outputDoc = Documents.Add(Visible:=False)
outputDoc.Range.Paste
outputDoc.SaveAs ActiveDocument.Path & "\" & baseFileName & "_Section_" & Right$("000" & currentSection.Index, 4) & ".docx"
outputDoc.Close
Next currentSection
Application.StatusBar = "All Done!"
Set outputDoc = Nothing
End Sub