Voici une macro qui va sauvegarder chaque section d'un document en un fichier indépendant. Cette macro est utile en particulier pour des fichiers issus du publipostage.

Sub SectionsDansDocumentsSéparés()
Application.ScreenUpdating = False
Dim SousDoc As Document
Dim R As Range
Dim S As Section
Dim DocNum


For Each S In ActiveDocument.Sections
Set R = S.Range:  R.End = R.End - 1
Set SousDoc = Documents.Add
ChangeFileOpenDirectory "C:\"
With SousDoc
DocNum = DocNum + 1
.Content = R
.SaveAs FileName:="test_" & DocNum & ".docx"
.Close
End With
Next S

Set SousDoc = Nothing
Set R = Nothing
Set S = Nothing
Application.ScreenUpdating = False

End Sub

 

Voici une autre macro proposée par Microsoft :

Sub couper_sections()
   Application.Browser.Target = wdBrowseSection

   For i = 1 To ((ActiveDocument.Sections.Count) - 1)

      'Selectionne et copie le texte de la section dans le presse-papier
      ActiveDocument.Bookmarks("\Section").Range.Copy

      'Crée un nouveau document et colle le texte du presse-papier
      Documents.Add
      Selection.Paste

   ' Retire le saut de section qui a été copié
      Selection.MoveUp Unit:=wdLine, Count:=1, Extend:=wdExtend
      Selection.Delete Unit:=wdCharacter, Count:=1

     ChangeFileOpenDirectory "C:\"
      DocNum = DocNum + 1
     ActiveDocument.SaveAs FileName:="test_" & DocNum & ".doc"
     ActiveDocument.Close
      'section suivante
     Application.Browser.Next
   Next i
   ActiveDocument.Close savechanges:=wdDoNotSaveChanges
End Sub