Sub Объединение_файлов()
    Dim avFiles, lr As Long
    Dim docAct As Document, docNow As Document

    With Application.FileDialog(msoFileDialogFilePicker)
        .InitialFileName = "*.doc*"
        .AllowMultiSelect = True
        If .Show = False Then Exit Sub
        Documents.Add
        Set docAct = ActiveDocument
        For lr = 1 To .SelectedItems.Count
            Set docNow = Documents.Open(.SelectedItems(lr))
            docNow.Range.Copy
            docAct.Range(docAct.Range.End - 1).Paste
            If lr < .SelectedItems.Count Then docAct.Range(docAct.Range.End - 1).InsertBreak Type:=wdSectionBreakNextPage
            docNow.Close 0
        Next lr
    End With
End Sub