Opmaak behouden bij uitvoer via VBA

Sub SplitDocument() ‘is naam in macrolijst
'
' SplitDocument Macro
'
Dim rng As Range
Dim i As Long
Dim intPages As Integer
Dim lngStart As Long
Dim lngEnd As Long
Dim strID As String
Dim wd As Document
Set rng = ActiveDocument.Content
lngStart = 1
intPages = ActiveDocument.BuiltInDocumentProperties(wdPropertyPages)
For i = 1 To intPages ‘het cijfer achter het =teken bepaald op welke pagina van het document wordt begonnen
Set rng = rng.GoTo(wdGoToSection, , i) ‘gebruik GoToPage bij handmatig Pagina-Einde
lngEnd = rng.Start - 1
If lngEnd > lngStart Then 'de eerste keer niet
ActiveDocument.Range(lngStart, lngEnd).Copy
Set wd = Documents.Add
wd.Content.Paste
wd.SaveAs "H:\Word\" & strID & " en voeg een naam toe.doc" ‘geeft pad  en bestandsnaam
wd.Close
End If
lngStart = lngEnd + 1
With rng.Find
.Text = "kenmerk^t:" ‘bestandsnaam wordt gezocht 
 
If .Execute = True Then
rng.Collapse wdCollapseEnd
rng.Move wdCharacter, 1
rng.Expand wdWord
strID = Trim(rng)
End If
End With
Next
ActiveDocument.Range(lngStart, ActiveDocument.Content.End).Copy
Set wd = Documents.Add
wd.Content.Paste
wd.SaveAs "H:\Word\" & strID & " en voeg een naam toe.doc"
wd.Close
Set wd = Nothing
End Sub

With ActiveDocument.PageSetup
 .LeftMargin = InchesToPoints(1.58)
 .RightMargin = InchesToPoints(1.58)
 .TopMargin = InchesToPoints(1.97)
 .BottomMargin = InchesToPoints(1.58)
End With