Function GetFolder() As String
    Dim oFolder As Object
    GetFolder = ""
    Set oFolder = CreateObject("Shell.Application").BrowseForFolder(0, "Choose a folder", 0)
    If (Not oFolder Is Nothing) Then GetFolder = oFolder.Items.Item.Path
    Set oFolder = Nothing
End Function
Sub MergeDocuments()
    Application.ScreenUpdating = False
    Application.DisplayAlerts = wdAlertsNone
    Dim strFolder As String, strFile As String
    Dim DocSrc As Document, DocTgt As Document
    Dim strDocNm As String, Rng As Range, HdFt As HeaderFooter
    strFolder = GetFolder
    If strFolder = "" Then Exit Sub
    Set DocTgt = ActiveDocument
    strDocNm = DocTgt.FullName
    strFile = Dir(strFolder & "\*.docx")
    While strFile <> ""
        If strFolder & "\" & strFile <> strDocNm Then
            Set DocSrc = Documents.Open(FileName:=strFolder & "\" & strFile, AddToRecentFiles:=False, Visible:=False)
            With DocTgt
 
                Set Rng = .Range.Characters.Last
                With Rng
                    .Collapse wdCollapseEnd
                    Call LayoutTransfer(DocSrc, DocTgt)
                    .FormattedText = DocSrc.Range.FormattedText
                    .Collapse wdCollapseEnd
                    '.Fields.Add Range:=Rng.Sections(-1).Footers(wdHeaderFooterPrimary).Range., Type:=wdFieldEmpty, Text:="INCLUDETEXT &""C:\\MERGEDOCS\\01_All\\Footer.docx"","
                    '.InsertBreak Type:=wdSectionBreakNextPage
                End With
 
 
 
                For Each HdFt In .Sections.Last.Headers
                    HdFt.LinkToPrevious = False
                Next
                For Each HdFt In .Sections.Last.Footers
                    HdFt.LinkToPrevious = False
                Next
                For Each HdFt In .Sections(.Sections.Count).Headers
                    With HdFt.Range
                        .FormattedText = DocSrc.Sections.Last.Headers(HdFt.Index).Range.FormattedText
                        .Characters.Last.Delete
                    End With
                Next
            End With
            DocSrc.Close False
        End If
        strFile = Dir()
    Wend
    Set Rng = Nothing: Set DocTgt = Nothing: Set DocSrc = Nothing
    Application.DisplayAlerts = wdAlertsAll
    Application.ScreenUpdating = True
End Sub
Sub LayoutTransfer1(DocSrc As Document, DocTgt As Document)
     '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
     'Get Page Setup parameters
    With DocSrc.Sections.First.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
     'Set Page Setup parameters
    With DocTgt.Sections.Last.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 Sub

                With Rng
                    .Collapse wdCollapseEnd
                    Call LayoutTransfer(DocSrc, DocTgt)
                    .FormattedText = DocSrc.Range.FormattedText
                    .Collapse wdCollapseEnd
                    '.Fields.Add Range:=Rng.Sections(-1).Footers(wdHeaderFooterPrimary).Range., Type:=wdFieldEmpty, Text:="INCLUDETEXT &""C:\\MERGEDOCS\\01_All\\Footer.docx"","
                    '.InsertBreak Type:=wdSectionBreakNextPage
                End With

                With Rng  
                    .Collapse wdCollapseEnd 
                    .InsertBreak Type:=wdSectionBreakNextPage 
                    .Collapse wdCollapseEnd 
                    Call LayoutTransfer(DocSrc, DocTgt) 
                    .FormattedText = DocSrc.Range.FormattedText
                End With

                For Each HdFt In .Sections(.Sections.Count - 1).Footers 
                    With HdFt.Range 
                        .FormattedText = DocSrc.Sections.Last. Footers(HdFt.Index).Range.FormattedText 
                        .Characters.Last.Delete 
                    End With 
                Next