Sub MergeDocs()
On Error GoTo ErrorHandler
Dim rng As Range
Dim MainDoc As Document
Dim strFile As String, strFolder As String
Dim Count As Long
    With Application.FileDialog(msoFileDialogFolderPicker)
        .Title = "Selectos"
        .AllowMultiSelect = False
        If .Show Then
            strFolder = .SelectedItems(1) & Application.PathSeparator
        Else
            Exit Sub
        End If
    End With
    Set MainDoc = Documents.Add
    strFile = Dir$(strFolder & "*.doc*")        ' can change to .docx
    Count = 0
    Do Until strFile = ""
        Count = Count + 1
        Set rng = MainDoc.Range
        With rng
            .Collapse wdCollapseEnd
            If Count > 1 Then
                .InsertBreak wdPageBreak  ' wdSectionBreakNextPage
                .End = MainDoc.Range.End
                .Collapse wdCollapseEnd
            End If
            .InsertFile strFolder & strFile
        End With
        strFile = Dir$()
    Loop
    MsgBox ("Files are merged")
lbl_Exit:
    Exit Sub
ErrorHandler:
    MsgBox (strFile)
    Resume Next
End Sub