Separar documentos combinados en Word con las mismas propiedades del doc original

Con lagunas limitaciones (pues toca ingresar alguna información de forma manual, se resalta con negrilla) este código fue el que logré que más se acercara a la solución:

Sub seleccionar_separar()

‘Separa el documento resultante de una combinación de correspondencia en varios documentos _permitiendo guardarlos en una carpeta definida por el usuario

Application.ScreenUpdating = False

ChangeFileOpenDirectory "C:\"

midire = "C:\Prueba_Combinacion"

If Dir(midire, vbDirectory) = "" Then

MkDir "C:\Prueba_Combinacion"

End If

ChangeFileOpenDirectory "C:\Prueba_Combinacion"

abogado = InputBox("Digite el nombre del abogado(a)")

midire2 = "C:\Prueba_Combinacion\" & abogado

Respuesta = MsgBox(abogado, vbOKCancel_)

If Respuesta = vbOK And Dir(midire2, vbDirectory) <> "" Then

ChangeFileOpenDirectory "C:\Prueba_Combinacion\" & abogado

ElseIf Respuesta = vbOK And Dir(midire2, vbDirectory) = "" Then

MkDir "C:\Prueba_Combinacion\" & abogado

ElseIf Respuesta = vbCancel Then

Exit Sub

End If

Dim MySection As Range

Dim UltimaSection As Double

UltimaSection = ActiveDocument.Sections.Count - 1

For i = 1 To UltimaSection

   Set MySection = ActiveDocument.Sections(i).Range

    With MySection

        .Copy

    End With

      Documents.Add

      Selection.PasteAndFormat (wdFormatOriginalFormatting)

        ActiveDocument.Select

     Selection.WholeStory

 With Selection.ParagraphFormat

        .LeftIndent = CentimetersToPoints(1.5)

        .RightIndent = CentimetersToPoints(0.2)

        .SpaceBefore = 0

        .SpaceBeforeAuto = False

        .SpaceAfter = 0

        .SpaceAfterAuto = False

        .LineSpacingRule = wdLineSpaceExactly

        .LineSpacing = 18

        '.Alignment = wdAlignParagraphJustify

        .WidowControl = True

        .KeepWithNext = False

        .KeepTogether = False

        .PageBreakBefore = False

        .NoLineNumber = False

        .Hyphenation = True

        .FirstLineIndent = CentimetersToPoints(0)

        .OutlineLevel = wdOutlineLevelBodyText

        .CharacterUnitLeftIndent = 0

        .CharacterUnitRightIndent = 0

        .CharacterUnitFirstLineIndent = 0

        .LineUnitBefore = 0

        .LineUnitAfter = 0

        .MirrorIndents = False

        .TextboxTightWrap = wdTightNone

    End With

With ActiveDocument.PageSetup

        .LineNumbering.Active = False

        .Orientation = wdOrientPortrait

        .TopMargin = CentimetersToPoints(3.3)

        .BottomMargin = CentimetersToPoints(1.3)

        .LeftMargin = CentimetersToPoints(1.2)

        .RightMargin = CentimetersToPoints(2.4)

        .Gutter = CentimetersToPoints(0)

        .HeaderDistance = CentimetersToPoints(1.25)

        .FooterDistance = CentimetersToPoints(1.25)

        .PageWidth = CentimetersToPoints(21)

        .PageHeight = CentimetersToPoints(29.7)

        .FirstPageTray = wdPrinterDefaultBin

        .OtherPagesTray = wdPrinterDefaultBin

        .SectionStart = wdSectionNewPage

        .OddAndEvenPagesHeaderFooter = False

        .DifferentFirstPageHeaderFooter = False

        .VerticalAlignment = wdAlignVerticalTop

        .SuppressEndnotes = False

        .MirrorMargins = False

        .TwoPagesOnOne = False

        .BookFoldPrinting = False

        .BookFoldRevPrinting = False

        .BookFoldPrintingSheets = 1

        .GutterPos = wdGutterPosLeft

    End With

'ActiveDocument.Save

'ActiveDocument.Close

ChangeFileOpenDirectory "C:\Prueba_Combinacion\" & abogado

      DocNum = DocNum + 1

     ActiveDocument.SaveAs FileName:= Abogado & " Minuta" & DocNum & ".doc"

     ActiveDocument.Close

Windows("Cartas1 [Modo de compatibilidad]").Activate

Next i

Application.ScreenUpdating = True

End Sub