MacScript("get clipboard as text")

    With ActiveWorkbook.Sheets
        With .Add(, .Item(.Count))
            .Parent.PivotCaches.Create(xlDatabase, "Лист1!R1C1:R" & iLastRow & "C" & iLastCol, 6) _
                .CreatePivotTable .Range("A3"), DefaultVersion:=6
        End With
    End With

Worksheets

ActiveWindow.SelectedSheets

=ГИПЕРССЫЛКА("file:///C:/%231/таблица.xlsx";"таблица.xlsx")

let
    Source =
        Excel.CurrentWorkbook(){[Name="Таблица1"]}[Content],
    Filtered =
        Table.SelectRows(Source, each ([Номер акта] <> null)),
    Typed =
        Table.TransformColumnTypes(
            Filtered,
            {
                {"дата начала", Int64.Type},
                {"дата окончания", Int64.Type},
                {"дата акта", type date},
                {"кол-во экз", Int64.Type},
                {"Номер п/п", Int64.Type}}
        ),
    Combined =
        Table.CombineColumns(
            Typed,
            {"дата начала", "дата окончания"},
            each {_{0}.._{1}},
            "Даты"
        ),
    Expand =
        Table.ExpandListColumn(Combined, "Даты"),
    Typed1 =
        Table.TransformColumnTypes(Expand,{{"Даты", type date}})
in
    Typed1

=СУММ(ЕСЛИОШИБКА(--ТЕКСТ(МУМНОЖ(ТРАНСП(Таблица18[[1]:[30]]*(Таблица18[Ф. И. О.]=B7)*(Таблица18[р/р]=расчет!D6&"/"&ОТБР(расчет!Q4*100)));Таблица18[год]^0*2)-1;"0;\0;\0");))*Q6*R6

Sub pivot_()

    Dim oWb As Workbook, oWsh As Worksheet, pt As PivotTable, _
        pitm As PivotItem, pitm_ As PivotItem, oRng As Range
        
    Set oWb = ThisWorkbook
    Set oWsh = oWb.Sheets("Сводная")
    Set pt = oWsh.[A1].PivotTable
    Set oRng = ActiveWindow.VisibleRange.Cells(1, 1)
    
    With Application
        .ScreenUpdating = False
        .Calculation = xlCalculationManual
    End With

    For Each pitm In pt.PivotFields!Dpt.VisibleItems
        With oWb.Sheets.Add(, oWb.Sheets(oWb.Sheets.Count))
            .Name = pitm.Caption
            pt.TableRange2.Copy .[A1]
            For Each pitm_ In .PivotTables(1) _
                    .PivotFields!Dpt _
                    .VisibleItems
                pitm_.Visible = pitm_.Caption = .Name
                Application.Goto .[A1], True
            Next
        End With
    Next
    
    Application.Goto oRng, True
    
    With Application
        .ScreenUpdating = True
        .Calculation = xlCalculationAutomatic
    End With
End Sub

    With GetObject(, "Outlook.Application")
        'текущее письмо, открытое в отдельном окне
        Set oMailItm = .ActiveInspector.CurrentItem
        'ответное письмо, созданное действием Ответить всем
        Set oReply = oMailItm.Actions("Ответить всем").Execute
        'отобразить ответное письмо
        oReply.display: AppActivate oReply.GetInspector.Caption
    End With

    Const PR_SMTP_ADDRESS$ = "http://schemas.microsoft.com/mapi/proptag/0x39FE001E"
    With GetObject(, "Outlook.Application")
        Set oMailItm = .ActiveInspector.CurrentItem
        With .CreateItem(0)
            myAddr = oMailItm.Session.CurrentUser.PropertyAccessor.GetProperty(PR_SMTP_ADDRESS)
            For Each r In oMailItm.Recipients
                sAddr = r.PropertyAccessor.GetProperty(PR_SMTP_ADDRESS)
                If myAddr <> sAddr Then s = s & """" & r.Name & """<" & sAddr & ">;"
            Next
            .To = "Коллега<name@domain.zone>;"
            .CC = s
            .Recipients.ResolveAll
            .Display
            AppActivate .GetInspector.Caption
        End With
    End With