=ПРОСМОТР(2;1/(D2>=C$13:U$13)/(E2>=C$15:U$15);ИНДЕКС(C:U;ПРОСМОТР(2;1/(B2>=A$16:A$47)/((B$16:B$47="")+(C2>=B$16:B$47));СТРОКА(A$16:A$47));))

Sub test_copy()

Dim rng As Range

Set rng = Range(Cells(1, 1), Cells(36, 8))

Cells(37, 1).Resize(36, 8) = rng.Value

End Sub

Sub test_copy_()
    With [A1].Resize(36, 8)
        .Offset(36) = .Value
    End With
End Sub

=B2/(ЕСЛИОШИБКА(Т(ПОИСК(":*:";C2));"0:")&C2)*64/675

{=({page}+1)/2}

{if {page} > 2 "{if {=MOD({={page}/2};1)} > 0 {=({page}+1)/2}}" ""}

let
    Source = Excel.CurrentWorkbook(){[Name="data"]}[Content],
    Group = Table.Group(Source, {"Column1", "Column3", "Column4","Column5","Column7"}, {{"Column2", each Text.Combine(List.Transform([Column2],Text.From),","), type text},{"Column6", each List.Sum([Column6]), type number}})
in
    Table.ReorderColumns(Group,Table.ColumnNames(Source))

Sub элемент_таблицы()
    Dim myRange As Range, myCell As Range, AL As Object, v As Variant, r As Variant, _
    myElement As Variant, i As Long, smyRange As Range, ssmyRange As Range
    Dim LastRow
    Dim sLastRow
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    LastRow = Sheets("Лист2").Cells(Sheets("Лист2").Rows.Count, 1).End(xlUp).Row
    sLastRow = Sheets("Лист3").Cells(Sheets("Лист3").Rows.Count, 1).End(xlUp).Row
    Set myRange = Sheets("Лист2").Range("A2:A" & LastRow)
    Set ssmyRange = Sheets("Лист3").Range("A2:A" & sLastRow)
    On Error Resume Next
    
    Set AL = CreateObject("system.Collections.Arraylist")

    For Each r In Array(myRange, ssmyRange)
        For Each v In r.Value
            If Not IsEmpty(v) And Not AL.contains(v) Then AL.Add v
    Next v, r
    AL.Sort

    On Error GoTo 0
    [проба!J2].Resize(, AL.Count) = AL.toarray
    
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
End Sub

let
    fn=(t)=>let
        Col = Table.ColumnNames(t),
        GroupBy = List.RemoveMatchingItems(Col,{Col{1},Col{5}}),
        List    = {{Col{1}, each Text.Combine(List.Transform(Table.Column(_,Col{1}),Text.From),",")},
                   {Col{5}, each List.Sum(Table.Column(_,Col{5}))}}
    in Table.ReorderColumns(Table.Group(t,GroupBy,List),Col),    
    Source    = Excel.CurrentWorkbook(){[Name="Таблица1"]}[Content],
    Source1   = Excel.CurrentWorkbook(){[Name="Таблица2"]}[Content],
    Merge     = Table.NestedJoin(fn(Source),{"Столбец1","Столбец4"},fn(Source1),{"Столбец1","Столбец4"},"2",3),
    Group     = Table.Group(Merge, {"2"}, {{"1", each Table.RemoveColumns(_,{"2"}), type table}})[[1],[2]],
    Transform = Table.FromRecords(Table.TransformRows(Group,(r)=>
                    Record.TransformFields(r,{
                        {"1",each Table.ReplaceValue(_,null,r[2]{0}[Столбец1],Replacer.ReplaceValue,{"Столбец1"})},
                        {"2",each Table.ReplaceValue(_,null,r[1]{0}[Столбец1],Replacer.ReplaceValue,{"Столбец1"})}
                    }))),
    ColN      = List.Zip(List.Transform(Table.ColumnNames(Source),each {_,"1."&_,"2."&_})),
    Result    = Table.ExpandTableColumn(Table.ExpandTableColumn(Transform, "1", ColN{0}, ColN{1}),"2", ColN{0}, ColN{2})
in
    Result

Sub test()
    On Error Resume Next
    ThisWorkbook.VBProject.References.AddFromFile Application.Path & "\MSPPT.OLB"
    On Error GoTo 0
    Dim pp As New PowerPoint.Application
    With pp.Presentations.Open(Environ("userprofile") & "\Documents\Презентация1.pptx")
        .ExportAsFixedFormat .Path & "\test.pdf", 2&, 2&
        .Close
    End With
    If pp.Presentations.Count = 0 Then pp.Quit
    Set pp = Nothing
End Sub

{"Столбец1","Столбец4"}

{"Столбец1","Столбец4","Столбец8"}

=DropDownList(Sheet1!$B$42)

=Список

Function DropDownList(r As Range) As Range
    
    Dim r0 As Range, r1 As Range
    Static b As Boolean

    If b Then: b = False: Exit Function
   
    Application.Volatile False
    Set r0 = Application.Caller
    If IsEmpty(r(2)) Then
        Set r1 = r
    Else
        Set r1 = r.Parent.Range(r, r.End(xlDown))
    End If
    Set DropDownList = r1
    If r1.Find(r0, , xlValues, xlWhole) Is Nothing And Not IsEmpty(r0) Then
        If MsgBox("Введеное начение не надено." & vbCr & _
                  "Добавить его в cписок?", vbQuestion Or vbYesNo) = vbYes Then
            r1.Offset(r1.Rows.Count)(1, 1) = r0
        Else
            b = True: Exit Function
        End If
    End If
End Function

Sub sdf()
    Dim v As Variant, ar As Range
    On Error Resume Next
    With ActiveSheet.UsedRange
        With Intersect(.Offset(4 - .Row), .Cells)
            For Each v In Array(xlCellTypeFormulas, xlCellTypeConstants)
                For Each ar In .SpecialCells(v, 23).EntireRow.Areas
                    Intersect(ar, .Parent.[B:B]).Value = .Parent.Name
            Next ar, v
        End With
    End With
End Sub

let
    fn=(t)=>let
        Col     = Table.ColumnNames(t),
        GroupBy = List.RemoveMatchingItems(Col,{Col{1},Col{5}}),
        List    = {{Col{1}, each Text.Combine(List.Transform(Table.Column(_,Col{1}),Text.From),",")},
                   {Col{5}, each List.Sum(Table.Column(_,Col{5}))}}
    in Table.ReorderColumns(Table.Group(t,GroupBy,List),Col),    
    Source    = Excel.CurrentWorkbook(){[Name="Таблица1"]}[Content],
    Source1   = Excel.CurrentWorkbook(){[Name="Таблица2"]}[Content],
    Merge     = Table.NestedJoin(fn(Source),{"Столбец1","Столбец4","Столбец8"},fn(Source1),{"Столбец1","Столбец4","Столбец8"},"2",3),
    Group     = Table.Group(Merge, {"2"}, {{"1", each Table.RemoveColumns(_,{"2"}), type table}})[[1],[2]],
    Transform = Table.FromRecords(Table.TransformRows(Group,(r)=>
                    Record.TransformFields(r,{
                        {"1",each Table.ReplaceValue(_,null,r[2]{0}[Столбец1],Replacer.ReplaceValue,{"Столбец1"})},
                        {"2",each Table.ReplaceValue(_,null,r[1]{0}[Столбец1],Replacer.ReplaceValue,{"Столбец1"})}
                    }))),
    ColN      = List.Zip(List.Transform(Table.ColumnNames(Source),each {_,"1."&_,"2."&_})),
    Result    = Table.ExpandTableColumn(Table.ExpandTableColumn(Transform, "1", ColN{0}, ColN{1}),"2", ColN{0}, ColN{2})
in
    Result

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim r As Range
    On Error Resume Next
    For Each r In Target.Rows
        With r.Cells(1, 1)
            If Not Intersect([$X$13:$X$18], .Cells) Is Nothing Then
                .Offset(1).EntireRow.Hidden = (.Value = "")
                For Each v In Array(Array("Заявление на деньги", 50), _
                    Array("Маршрутный лист", 7), _
                    Array("СЗ по прибытию", 11), _
                    Array("Авансовый отчет", 12))
                    xx(Evaluate("'" & v(0) & "'!A1"), .Row - 12, v(1)).Hidden = (.Value = "")
                Next
            End If
        End With
    Next
End Sub
Function xx(ByRef r As Range, i, n) As Range
    Set xx = r.Offset(, i * n).Resize(, n).EntireColumn
End Function

#If VBA7 <> 1 Then
    Function ЕСЛИОШИБКА(ByVal проверяемое_значение As Variant, ByVal значение_если_ошибка As Variant) As Variant
    Dim i As Long, j As Long
        If IsArray(проверяемое_значение) Then
            On Error Resume Next
            j = UBound(проверяемое_значение, 2)
            If Err Then
                Err.Clear
                For i = 1 To UBound(проверяемое_значение)
                    If IsError(проверяемое_значение(i)) Then проверяемое_значение(i) = значение_если_ошибка
                Next
            Else
                For i = 1 To UBound(проверяемое_значение)
                    For j = 1 To UBound(проверяемое_значение, 2)
                        If IsError(проверяемое_значение(i, j)) Then проверяемое_значение(i, j) = значение_если_ошибка
                    Next
                Next
            End If
        Else
            If IsError(проверяемое_значение) Then проверяемое_значение = значение_если_ошибка
        End If
        ЕСЛИОШИБКА = проверяемое_значение
    End Function
#End If

=АРГУМЕНТ("a";95)*АРГУМЕНТ("b";95)*РЕЗУЛЬТ(95)
=ВОЗВРАТ(ВЫЧИСЛИТЬ("еслиошибка(a;b)"))