Sub consolid_otchet()
    
    Dim DFP As String                   ' папка размещения файлов
    Dim LST_OTCH As String              ' имя листа для размещения отчета
    Dim CountFl As Integer              ' количество исходных файлов для отчета
    Dim PoleOtch As String              ' строка с описанием диапазона ячеек, вкл в отчет
    Dim lngCount As Long                ' текущий номер обрабатываемого файла

    Dim arr_FL(3) As String             ' массив с полными именами исходных файлов

    dfn = Range("D1").Value
    DFP = Range("D5").Value
    
    LST_OTCH = Range("D7").Value
   
    PoleOtch = "Лист1'!R6C1:R32C22"
    lngCount = 0
    
    Set WB_osn = ActiveWorkbook   'осн файл
        
' почему-то урезается путь к файлам загрузки
' Эти строчки путь восстанавливают
    Range("D5").Select
    Selection.Cut Destination:=Range("D6")
    Range("D6").Select
    Selection.Cut Destination:=Range("D5")
    Range("D5").Select
    
    ChDir DFP
    With Application.FileDialog(msoFileDialogOpen)
        .AllowMultiSelect = True
        .Show
        CountFl = .SelectedItems.Count

        For lngCount = 1 To CountFl
        
            pr_NoList = 0
                Imf_fl = .SelectedItems(lngCount)   ' Имя выбранного файла
               ' MsgBox Imf_fl                      ' вывод имени выбранного файла на экран
                Workbooks.Open Filename:=.SelectedItems(lngCount) ' Открытие файла
                Set WB = ActiveWorkbook   ' отчет отдела

' Заполнение массива
                arr_FL(lngCount - 1) = WB.Path & "[" & WB.Name & "]Лист1'!R6C1:R30C22"
               
                'MsgBox arr_FL(lngCount)
                
        Next lngCount
   
    WB_osn.Activate
    Worksheets(LST_OTCH).Activate
    Selection.Consolidate Sources:=arr_FL, Function:=xlSum
    
    End With
    
End Sub

Sub Макрос1()                                                                                                           '   
Dim mas(7) As Variant                                                                                                                                                                                                                        
 
 mas(0) = "'C:\OTCHET\[МР_6.xlsx]Лист1'!R1C1:R26C22"   
 mas(1) = "'C:\OTCHET\[город.xlsx]Лист1'!R1C1:R28C22"
 mas(2) = "'C:\OTCHET\[МР_1.xlsx]Лист1'!R1C1:R26C22"                                                                    
 mas(3) = "'C:\OTCHET\[МР_2.xlsx]Лист1'!R1C1:R26C22"                                                                    
 mas(4) = "'C:\OTCHET\[МР_3.xlsx]Лист1'!R1C1:R26C22"                                                                    
 mas(5) = "'C:\OTCHET\[МР_4.xlsx]Лист1'!R1C1:R26C22"                                                                    
 mas(6) = "'C:\OTCHET\[МР_5.xlsx]Лист1'!R1C1:R26C22"                                                                    
                                                                                                                                                                                            
  Selection.Consolidate Sources:=mas,   Function:=xlSum
End sub

Sub Макрос1()                                                                                                           '                                                                                                                                                                
 Dim mas(40) As Variant                                                                                                                                                                                                                         

 mas(1) = "'C:\OTCHET\[город.xlsx]Лист1'!R1C1:R28C22" 
 mas(2) = "'C:\OTCHET\[МР_1.xlsx]Лист1'!R1C1:R26C22"                                                                    
 mas(3) = "'C:\OTCHET\[МР_2.xlsx]Лист1'!R1C1:R26C22"                                                                    
 mas(4) = "'C:\OTCHET\[МР_3.xlsx]Лист1'!R1C1:R26C22"                                                                     
 mas(5) = "'C:\OTCHET\[МР_4.xlsx]Лист1'!R1C1:R26C22"                                                                     
 mas(6) = "'C:\OTCHET\[МР_5.xlsx]Лист1'!R1C1:R26C22"                                                                     
 mas(7) = "'C:\OTCHET\[МР_6.xlsx]Лист1'!R1C1:R26C22"                                                                                                                                                                                               
  Selection.Consolidate Sources:=Array(mas(1), mas(2), mas(3), mas(4), mas(5), mas(6), mas(7)),   Function:=xlSum
End sub

Sub Макрос_Otchet()
'
Worksheets("Sheet1").Range("A1").Consolidate _
    Sources:=Array( _
                    "Sheet2!R1C1:R37C6", _
                    "Sheet3!R1C1:R37C6" _
                ), _
    Function:=xlSum

End Sub

=РАБДЕНЬ.МЕЖД(ДАТА(год;МЕСЯЦ(месяц&"1");1)-1;1;1;праздники)

Sub delenie_na_fio()

    Dim imf_save As String
    Dim pole_otd As Integer
    Dim put_fl As String
               
put_fl = "D:\Work\Заявления\"
                n = 0
                
On Error Resume Next
  ActiveDocument.MailMerge.DataSource.ActiveRecord = wdFirstRecord
  Do
    With ActiveDocument.MailMerge
        .Destination = wdSendToNewDocument
        .SuppressBlankLines = True
        With .DataSource
            .FirstRecord = ActiveDocument.MailMerge.DataSource.ActiveRecord
            .LastRecord = ActiveDocument.MailMerge.DataSource.ActiveRecord
        
        pole_fam = ActiveDocument.MailMerge.DataSource.DataFields(2).Value
        pole_otd = ActiveDocument.MailMerge.DataSource.DataFields(3).Value
        pole = pole_otd & " " & pole_fam

        Application.StatusBar = pole
            imf_save = put_fl & pole & " заявление.doc"

        End With
        .Execute Pause:=False
    
    End With
    
    ActiveDocument.SaveAs FileName:= _
        imf_save, FileFormat:= _
        wdFormatDocument, LockComments:=False, Password:="", AddToRecentFiles:= _
        True, WritePassword:="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts:= _
        False, SaveNativePictureFormat:=False, SaveFormsData:=False, _
        SaveAsAOCELetter:=False
    ActiveDocument.Close
    ActiveDocument.MailMerge.DataSource.ActiveRecord = wdNextRecord

                n = n + 1
       Loop Until n = ActiveDocument.MailMerge.DataSource.RecordCount

End Sub