adding section ffom another document with formatting

[jat098]

I'm trying through VBA code to add a one page Word document (with text and format/layout, e.g., columns) as a new section in another Word document. The latter document has a different layout and font.

I know how to create a new section, but how do I tell Word to paste to the new section?

Thanks

[fumei]

See macropod's answer on how to make a new section and copy in (with formatting) from another document. It is post #26.

[macropod]

Since Jerry (fumei) didn't provide a link. Here's the actual code. All you need to do is to edit:
strFile = "C:\Users\" & Environ("UserName") & "\Documents\SomeDocument.doc"
to suit your needs. Since the code points to your 'My Documents' folder, you may only need to add whatever additional folder structure you have and change the filename.
Sub ImportDocument()
Application.ScreenUpdating = False
Dim wdDoc As Document, strFile As String, Rng As Range, HdFt As HeaderFooter, i As Long
strFile = "C:\Users\" & Environ("UserName") & "\Documents\SomeDocument.doc"
With ActiveDocument
' If there is more than one Section, unlink the headers & footers from the
' 1st Section so the new Section's content won't impact subsequent Sections.
If .Sections.Count > 1 Then
With .Sections(2)
For Each HdFt In .Headers
HdFt.LinkToPrevious = False
Next
For Each HdFt In .Footers
HdFt.LinkToPrevious = False
Next
End With
End If
Set Rng = .Sections(1).Range
With Rng
' If there's already a Section break, move back one character.
If Asc(.Characters.Last) = 12 Then
.End = .End - 1
End If
' Ensure there's an empty paragraph for the new Section.
While Asc(.Characters.Last.Previous) <> 13
.InsertAfter vbCr
Wend
.End = .End - 1
.Collapse wdCollapseEnd
End With
' Add the new Section
.Sections.Add Range:=Rng, Start:=wdSectionNewPage
' Unlink the headers & footers from the 1st Section so
' the new Section's content won't impact first Section.
With .Sections(2)
For Each HdFt In .Headers
HdFt.LinkToPrevious = False
Next
For Each HdFt In .Footers
HdFt.LinkToPrevious = False
Next
Set Rng = .Range
Rng.Collapse wdCollapseStart
' Open the source document as read-only.
Set wdDoc = Documents.Open(FileName:=strFile, AddToRecentFiles:=False, Visible:=False)
' Insert the new content, retaining its formatting.
With wdDoc
.Range.Copy
Rng.PasteAndFormat Type:=wdFormatOriginalFormatting
i = .Sections.Count
' Replicate the last Section's page layout.
Call ReplicateLayout(.Sections(i), Rng.Sections(i))
' Replicate the last Section's headers & footers.
For Each HdFt In .Sections(i).Headers
With Rng.Sections(i).Headers(HdFt.Index)
If .Exists Then
HdFt.Range.Copy
.Range.PasteAndFormat Type:=wdFormatOriginalFormatting
.Range.Characters.Last.Delete
End If
End With
Next
For Each HdFt In .Sections(i).Footers
With Rng.Sections(i).Footers(HdFt.Index)
If .Exists Then
HdFt.Range.Copy
.Range.PasteAndFormat Type:=wdFormatOriginalFormatting
.Range.Characters.Last.Delete
End If
End With
Next
' Close the source document.
.Close SaveChanges:=False
End With
End With
End With
Set wdDoc = Nothing: Set Rng = Nothing
Application.ScreenUpdating = True
End Sub
'
'
'
Sub ReplicateLayout(ScnIn As Section, ScnOut As Section)
'Document Body variables
Dim sPageHght As Single, sPageWdth As Single
Dim sHeaderDist As Single, sFooterDist As Single
Dim sTMargin As Single, sBMargin As Single
Dim sLMargin As Single, sRMargin As Single
Dim sGutter As Single, sGutterPos As Single
Dim lPaperSize As Long, lGutterStyle As Long
Dim lMirrorMargins As Long, lVerticalAlignment As Long
Dim lScnStart As Long, lScnDir As Long
Dim lOddEvenHdFt As Long, lDiffFirstHdFt As Long
Dim bTwoPagesOnOne As Boolean, bBkFldPrnt As Boolean
Dim bBkFldPrnShts As Boolean, bBkFldRevPrnt As Boolean
Dim bOrientation As Boolean
'Populate Document Body variables
With ScnIn
With .PageSetup
lPaperSize = .PaperSize
lGutterStyle = .GutterStyle
bOrientation = .Orientation
lMirrorMargins = .MirrorMargins
lScnStart = .SectionStart
lScnDir = .SectionDirection
lOddEvenHdFt = .OddAndEvenPagesHeaderFooter
lDiffFirstHdFt = .DifferentFirstPageHeaderFooter
lVerticalAlignment = .VerticalAlignment
sPageHght = .PageHeight
sPageWdth = .PageWidth
sTMargin = .TopMargin
sBMargin = .BottomMargin
sLMargin = .LeftMargin
sRMargin = .RightMargin
sGutter = .Gutter
sGutterPos = .GutterPos
sHeaderDist = .HeaderDistance
sFooterDist = .FooterDistance
bTwoPagesOnOne = .TwoPagesOnOne
bBkFldPrnt = .BookFoldPrinting
bBkFldPrnShts = .BookFoldPrintingSheets
bBkFldRevPrnt = .BookFoldRevPrinting
End With
End With
'Replicate the variables in the output document
With ScnOut
With .PageSetup
.GutterStyle = lGutterStyle
.MirrorMargins = lMirrorMargins
.SectionStart = lScnStart
.SectionDirection = lScnDir
.OddAndEvenPagesHeaderFooter = lOddEvenHdFt
.DifferentFirstPageHeaderFooter = lDiffFirstHdFt
.VerticalAlignment = lVerticalAlignment
.PageHeight = sPageHght
.PageWidth = sPageWdth
.TopMargin = sTMargin
.BottomMargin = sBMargin
.LeftMargin = sLMargin
.RightMargin = sRMargin
.Gutter = sGutter
.GutterPos = sGutterPos
.HeaderDistance = sHeaderDist
.FooterDistance = sFooterDist
.TwoPagesOnOne = bTwoPagesOnOne
.BookFoldPrinting = bBkFldPrnt
.BookFoldPrintingSheets = bBkFldPrnShts
.BookFoldRevPrinting = bBkFldRevPrnt
.PaperSize = lPaperSize
.Orientation = bOrientation
End With
End With
End Sub

[fumei]

Darn, and I even did a copy of the link...then forgot to paste it.

Oooops. Hopefully the code macropod so nicely posted will work for you.

Let us know. Thanks Paul.