Découper document suite à Publipostage et conserver mise en page

Bonjour,

À l'aide de plusieurs posts que j'ai trouvé ici et ailleurs, j'ai construit le code suivant qui permet de découper un document de publipostage en plusieurs documents en invitant l'utilisateur à sélectionner son dossier. L'enjeux est que la mise en page du document ne suivait pas, j'ai donc corrigé en modifiant le tout dans le code (peut-être est-ce qu'il y a une meilleure façon de faire?).

L'enjeux présentement est que les en-têtes et pieds de page ne suivent pas dans les documents, est-ce quelqu'un aurait une idée comment corriger le tout?

Voici le code:

Sub couper_sections() 'numéro de contrat (avec mise en page automatique)
Application.Browser.Target = wdBrowseSection


Dim sFolder As String
' Open the select folder prompt
With Application.FileDialog(msoFileDialogFolderPicker)
If .Show = -1 Then ' if OK is pressed
sFolder = .SelectedItems(1)
End If
End With

If sFolder <> "" Then ' if a file was chosen

ChangeFileOpenDirectory sFolder
End If

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.WholeStory
With ActiveDocument.Styles(wdStyleNormal).Font
If .NameFarEast = .NameAscii Then
.NameAscii = ""
End If
.NameFarEast = ""
End With
ActiveDocument.Content.Orientation = wdTextOrientationHorizontal
With ActiveDocument.PageSetup
.LineNumbering.Active = False
.Orientation = wdOrientPortrait
.TopMargin = InchesToPoints(1)
.BottomMargin = InchesToPoints(1)
.LeftMargin = InchesToPoints(1)
.RightMargin = InchesToPoints(1)
.Gutter = InchesToPoints(0)
.HeaderDistance = InchesToPoints(0.6)
.FooterDistance = InchesToPoints(0.6)
.PageWidth = InchesToPoints(8.5)
.PageHeight = InchesToPoints(11)
.FirstPageTray = wdPrinterDefaultBin
.OtherPagesTray = wdPrinterDefaultBin
.SectionStart = wdSectionNewPage
.OddAndEvenPagesHeaderFooter = False
.DifferentFirstPageHeaderFooter = True
.VerticalAlignment = wdAlignVerticalTop
.SuppressEndnotes = False
.MirrorMargins = False
.TwoPagesOnOne = False
.BookFoldPrinting = False
.BookFoldRevPrinting = False
.BookFoldPrintingSheets = 1
.GutterPos = wdGutterPosLeft
.SetAsTemplateDefault
End With
With Selection.ParagraphFormat
.LeftIndent = InchesToPoints(0)
.RightIndent = InchesToPoints(0)
.SpaceBefore = 0
.SpaceBeforeAuto = False
.SpaceAfter = 0
.SpaceAfterAuto = False
.LineSpacingRule = wdLineSpaceSingle
.Alignment = wdAlignParagraphLeft
.WidowControl = True
.KeepWithNext = False
.KeepTogether = False
.PageBreakBefore = False
.NoLineNumber = False
.Hyphenation = True
.FirstLineIndent = InchesToPoints(0)
.OutlineLevel = wdOutlineLevelBodyText
.CharacterUnitLeftIndent = 0
.CharacterUnitRightIndent = 0
.CharacterUnitFirstLineIndent = 0
.LineUnitBefore = 0
.LineUnitAfter = 0
.MirrorIndents = False
.TextboxTightWrap = wdTightNone
.CollapsedByDefault = False
End With


'******************************************************************


Selection.PasteAndFormat (wdFormatOriginalFormatting)


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


DocNum = DocNum + 1
ActiveDocument.SaveAs FileName:="Contrat_" & DocNum & ".doc"
ActiveDocument.Close
'section suivante
Application.Browser.Next
Next i
ActiveDocument.Close savechanges:=wdDoNotSaveChanges

End Sub

Merci beaucoup!