Sub drop()
Dim sFolder As String, sFiles As String
Dim i As Long, LR As Long, RV As String
    With Application.FileDialog(msoFileDialogFolderPicker) 'диалоговое окно , с его помощью определяем место сохранения файлов
        If .Show = False Then Exit Sub
        sFolder = .SelectedItems(1)
    End With       
    sFolder = sFolder & IIf(Right(sFolder, 1) = Application.PathSeparator, "", Application.PathSeparator)
    LR = Cells(Rows.Count, 1).End(xlUp).Row ' определяет последнюю ячейку со значениями в колонке
    For i = 2 To LR Step 4  ' каждые 4 строки начиная со 2 по LR
         RV = Cells(i, 1) 'номер отделения
         Workbooks.Add ' создаёт файл
         ThisWorkbook.Sheets(1).Range(Cells(i, 1), Cells(i + 3, 3)).Copy Destination:=ActiveWorkbook.Sheets(1).Range("B2")   'копирует и вставляет значения
        ActiveWorkbook.SaveAs Filename:=sFolder & "BR " & RV & " Execution", FileFormat:=xlWorkbookNormal
         ActiveWorkbook.Close True 'закрывает и сохраняет
    Next i           
End Sub

Sub Кнопка3_Щелчок()
Dim rng As Range, sh As Worksheet, sh2 As Worksheet, sh3 As Worksheet, wh As Worksheet, lr As Long, lr2 As Long
Set sh = Worksheets("журнал ОСТ осмотры")
Set sh2 = Worksheets("журнал ОСТ")
Set sh3 = Worksheets("Общая")
sh3.Range("A3:L100000").Clear
For Each wh In Worksheets
    If wh.Name = sh.Name Or wh.Name = sh2.Name Then
        lr = wh.Cells(Rows.Count, 3).End(xlUp).Row
        lr2 = sh3.Cells(Rows.Count, 3).End(xlUp).Row + 1
        If lr <= 2 Then Exit For
        wh.Range(wh.Cells(3, 1), wh.Cells(lr, 12)).Copy
        sh3.Cells(lr2, 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    End If
Next wh
End Sub

=ЕСЛИ(C14="";"";ЕСЛИ(C14="Изменение с начала";ПРОСМОТР(2;1/($C13:C$13<>"");$C13:C$13)-ИНДЕКС($C12:C$13;ПОИСКПОЗ(ЛОЖЬ;ЕПУСТО($C$13:$C$30);-1);1);ПРОСМОТР(2;1/($C13:C$13<>"");$C13:C$13)-C14))

Sub Кнопка1_Щелчок()
Dim wb As Workbook, i As Long, lr As Long, bn As String
lr = Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To lr Step 3
bn = Cells(i, 1)
    For Each wb In Workbooks
    On Error Resume Next
    xxx = Split(Split(wb.Name, "-")(1), ".")(0)
        If bn = xxx Then
            wb.Sheets(1).Range("B2:B4").Copy Destination:=ThisWorkbook.Sheets(1).Cells(i, 4): Exit For
        End If
    Next wb
Next i
End Sub

Sub Кнопка3_Щелчок()
Dim rng As Range, sh As Worksheet, sh2 As Worksheet, sh3 As Worksheet, wh As Worksheet, lr As Long, lr2 As Long
Set sh = Worksheets("журнал ОСТ осмотры")
Set sh2 = Worksheets("журнал ОСТ")
Set sh3 = Worksheets("Общая")
sh3.Range("A3:L100000").Clear
For Each wh In Worksheets
    If wh.Name = sh.Name Or wh.Name = sh2.Name Then
        lr = wh.Cells(Rows.Count, 3).End(xlUp).Row
        lr2 = sh3.Cells(Rows.Count, 3).End(xlUp).Row + 1
        If lr <= 2 Then Exit For
        wh.Range(wh.Cells(3, 1), wh.Cells(lr, 12)).Copy Destination:=sh3.Cells(lr2, 1)
    End If
Next wh
End Sub

Sub mrshkei()
Dim arr, i As Long, arr2, n As Long, lr As Long
lr = Cells(Rows.Count, 1).End(xlUp).Row
 Range("A2:A" & lr).Select
    ActiveWorkbook.Worksheets("Лист1").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Лист1").Sort.SortFields.Add Key:=Range("A2:A" & lr) _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Лист1").Sort
        .SetRange Range("A1:A" & lr)
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    ActiveSheet.Range("$A$1:$A$" & lr).RemoveDuplicates Columns:=1, Header:=xlYes
    
lr = Cells(Rows.Count, 1).End(xlUp).Row
arr = Range("A2:A" & lr)
ReDim arr2(1 To Int(lr / 9), 1 To 1): k = 1
For i = LBound(arr) To UBound(arr) Step 9
    For n = 1 To 9
        If arr2(k, 1) = Empty Then
            arr2(k, 1) = arr(i + n - 1, 1)
        Else
            arr2(k, 1) = arr2(k, 1) & " " & arr(i + n - 1, 1)
        End If
    Next n
    k = k + 1
Next i
Range("C1").Resize(UBound(arr2), 1) = arr2
Range("C1").Select
End Sub

=ПРОСМОТР(2;1/((Сертификаты!$C$2:$C$32<=$B2)*($E2=Сертификаты!$A$2:$A$32));Сертификаты!$B$2:$B$32&" от "&ТЕКСТ(Сертификаты!$C$2:$C$32;"ДД.ММ.ГГГГ"))