Option Explicit 'В модуле обязательно объявлять переменные. Да, да, оказывается в VBA можно не объявлять переменные.
 
Sub Таблица_поумничай()     'Название макроса
    CloseEmptyWb    'Вызов вспомогательной процедуры для закрытия "пустых" книг.
    ActiveSheet.Copy    'Копируем активный лист в новую книгу.
     
    Dim xx As Long, colName As Variant
    For xx = ActiveSheet.UsedRange.Columns.Count To ActiveSheet.UsedRange.Column Step -1    'Перебираем столбцы с последнего до первого
        For Each colName In Array("Приоритет", "Осталось на выполнение", "Категории")   'Перебираем названия столбцов для удаления
            If Cells(1, xx).Value = colName Then    'Если значение в первой строке равно названию для удаления
                Columns(xx).EntireColumn.Delete     'удаляем весь столбец
            End If
        Next
    Next
    ActiveSheet.Shapes(1).Delete    'Удаляем кнопку, которая скопировалась вместе с листом.
    ActiveSheet.ListObjects.Add(xlSrcRange, ActiveSheet.UsedRange, , xlYes).Name = "Таблица1"   'Создаём умную таблицу.
    ActiveSheet.ListObjects(1).TableStyle = "TableStyleLight13" 'Задаём стиль умной таблицы
    ActiveSheet.ListObjects(1).ShowTotals = True    'Отображаем строку итогов.
    ActiveSheet.ListObjects(1).ListColumns("Статус").TotalsCalculation = xlTotalsCalculationCount   'В строке итогов в столбце Статус ставим формулу подсчёта значений
    ActiveSheet.ListObjects(1).ListColumns("Изменена").TotalsCalculation = xlTotalsCalculationNone  'В строке итогов в столбце Изменена ставим формулу подсчёта значений
    ActiveSheet.ListObjects(1).Range.Select 'Выделяем диапазон умной таблицы.
End Sub
 
Private Sub CloseEmptyWb() 'Вспомогательная процедура для закрытия "пустых" книг.
    Dim wb As Workbook
    For Each wb In Application.Workbooks    'Перебираем книги в приложении
        If wb.Path = "" Then wb.Close False 'Если книга не была ни разу сохранена, закрыть без сохранения.
    Next
End Sub

=ИНДЕКС(СМЕЩ(B12;ПОИСКПОЗ(A4;A13:A20;0);0;СЧЁТЕСЛИМН(A13:A20;A4);1);ПОИСКПОЗ(B4;СМЕЩ(B12;ПОИСКПОЗ(A4;A13:A20;0);0;СЧЁТЕСЛИМН(A13:A20;A4);1);1))

Public Sub FormToc(sh As Worksheet)
    Const skip = "Главная Содержание Результаты"
    Dim aSkip As Variant
    aSkip = Split(skip, " ")
    
    Dim nn As Long
    nn = ThisWorkbook.Worksheets.Count - (UBound(aSkip) + 1)
    nn = WorksheetFunction.RoundUp(Sqr(nn), 0)
    
    Dim arr As Variant, xa As Long, ya As Long
    ReDim arr(1 To nn, 1 To nn)
    ya = 1
    
    Dim iSh As Worksheet
    For Each iSh In ThisWorkbook.Worksheets
        If InStr(skip, iSh.Name) = 0 Then
            xa = xa + 1
            If xa > UBound(arr, 2) Then
                xa = 1
                ya = ya + 1
            End If
            arr(ya, xa) = iSh.Name
        End If
    Next
    
    Dim rr As Range
    Set rr = sh.Range("B2").Resize(UBound(arr, 1), UBound(arr, 2))
    rr.Value = arr
    rr.EntireColumn.AutoFit
End Sub

Private Sub Следующий_Click()
    Worksheets("Отчёт1. стр. (2)").Visible = True
    Worksheets("Отчёт1. стр. (2)").Activate
    Me.Visible = False
End Sub

=C1--(СЧЁТЕСЛИМН(Double[Итог];[@[Все_каб]];Double[Смена];C$1)=0)*(СЧЁТЕСЛИМН(Double[Итог];[@[Все_каб]])<2)*(СЧЁТЕСЛИМН(Minus_cab;[@[Все_каб]])=0)*(СЧЁТЕСЛИМН(withdraw_cab;[@[Все_каб]])=0)

=B1--(СЧЁТЕСЛИМН(Double[Корр];[@[Все_каб]])<2)*(СЧЁТЕСЛИМН(Minus_cab;[@[Все_каб]])=0)*(СЧЁТЕСЛИМН(withdraw_cab;[@[Все_каб]])=0)

*(СЧЁТЕСЛИМН(Minus_cab;[@[Все_каб]])=0)*(СЧЁТЕСЛИМН(withdraw_cab;[@[Все_каб]])=0)

Option Explicit

Sub Таблица_поумничай()
    CloseEmptyWb
    ActiveSheet.Copy
    
    Dim xx As Long, colName As Variant
    For xx = ActiveSheet.UsedRange.Columns.Count To ActiveSheet.UsedRange.Column Step -1
        For Each colName In Array("Приоритет", "Осталось на выполнение", "Категории")
            If Cells(1, xx).Value = colName Then
                Columns(xx).EntireColumn.Delete
            End If
        Next
    Next
    ActiveSheet.Shapes(1).Delete
    ActiveSheet.ListObjects.Add(xlSrcRange, ActiveSheet.UsedRange, , xlYes).Name = "Таблица1"
    ActiveSheet.ListObjects(1).TableStyle = "TableStyleLight13"
    ActiveSheet.ListObjects(1).ShowTotals = True
    ActiveSheet.ListObjects(1).ListColumns("Статус").TotalsCalculation = xlTotalsCalculationCount
    ActiveSheet.ListObjects(1).ListColumns("Изменена").TotalsCalculation = xlTotalsCalculationNone
    ActiveSheet.ListObjects(1).Range.Select
End Sub

Private Sub CloseEmptyWb()
    Dim wb As Workbook
    For Each wb In Application.Workbooks
        If wb.Path = "" Then wb.Close False
    Next
End Sub

=5-ЕСЛИОШИБКА(ПОИСКПОЗ(G3;СМЕЩ(Дэшборд!$G$3:$K$3;СТОЛБЕЦ(A1)-1;0);1);0)+(G3=СМЕЩ(Дэшборд!$K$3;СТОЛБЕЦ(A1)-1;0))

Option Explicit
Private Const FIO_CELL = "B1"
Private Const FIRST_DATA_ROW = 4

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Address(0, 0, xlA1) <> FIO_CELL Then Exit Sub
    
    Dim rr As Range, arr As Variant, ya As Long, xa As Long
    Set rr = Intersect(ActiveSheet.UsedRange, Rows(FIRST_DATA_ROW).Resize(ActiveSheet.UsedRange.Rows.Count))
    
    rr.EntireRow.Hidden = False
    If IsEmpty(Target.Value) Then Exit Sub
    arr = rr.Value
    
    Dim Target_Value As Variant
    Target_Value = Target.Value
    For ya = UBound(arr, 1) To LBound(arr, 1) Step -1
        For xa = LBound(arr, 2) To UBound(arr, 2)
            If InStr(arr(ya, xa), Target_Value) <> 0 Then GoTo skipRow
        Next
        rr.Rows(ya).EntireRow.Hidden = True
skipRow:
    Next
End Sub

=ПСТР(ПОДСТАВИТЬ($B$6;СИМВОЛ(10);" ");(СТРОКА(A1)-1)*ДЛСТР("12528848104/ ")+1;ДЛСТР("12528848104"))

=СМЕЩ(class!$F$2;0;Double[@Смена];СМЕЩ(class!$I$1;0;Double[@Смена]);1)

Option Explicit
'v4
Private Const DATE_ADDRESS = "B12"
Private Const PROBE_ADDRESS = "A20"
Private Const PROBE_MASK = "K.O.*/К.О.*"
Private Const SOURCE_ADDRESS = "A:G"
 
Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Address(0, 0, xlA1) <> DATE_ADDRESS Then Exit Sub
     
    Dim probes As Variant
    probes = GetProbesArray(Sheets("Gold XRF").UsedRange, Target.Value)
     
    PrintArray probes, Range(PROBE_ADDRESS)
End Sub
 
Private Sub PrintArray(probes As Variant, rPrint As Range)
    If IsEmpty(probes) Then
        rPrint.Resize(rPrint.Parent.UsedRange.Rows.Count, Range(SOURCE_ADDRESS).Columns.Count).ClearContents
        Exit Sub
    End If
    rPrint.Resize(rPrint.Parent.UsedRange.Rows.Count, UBound(probes, 2)).ClearContents
    
    Set rPrint = rPrint.Resize(UBound(probes, 1), UBound(probes, 2))
    rPrint.Rows(1).Copy rPrint
    rPrint.Value = probes
End Sub
 
Private Function GetProbesArray(rSource As Range, sample As Variant) As Variant
    If IsEmpty(sample) Then Exit Function
     
    Set rSource = Intersect(rSource, rSource.Parent.Range(SOURCE_ADDRESS))
     
    Dim sour As Variant, targ As Variant, yt As Long
    sour = rSource.Value
     
    Dim ys As Long, xs As Long, vMask As Variant, aMask As Variant
    aMask = Split(PROBE_MASK, "/")
    For ys = 1 To UBound(sour, 1)
        'For xs = 1 To UBound(sour, 2) - 1
            If sour(ys, 1) = sample Then
                For Each vMask In aMask
                    If sour(ys, 2) Like vMask Then
                        ArrayInsert targ, sour, ys, yt
                    End If
                Next
            End If
'        Next
    Next
    If yt = 0 Then Exit Function
     
    GetProbesArray = AddNumber(targ, yt)
End Function
 
Private Function AddNumber(targ As Variant, yt As Long) As Variant
    Dim res As Variant
    ReDim res(1 To yt, 1 To UBound(targ(1)))
     
    Dim xs As Long
    For yt = 1 To UBound(res, 1)
        res(yt, 1) = yt
        For xs = 2 To UBound(res, 2)
            res(yt, xs) = targ(yt)(xs)
        Next
    Next
    AddNumber = res
End Function
 
Private Sub ArrayInsert(targ As Variant, sour As Variant, ys As Long, yt As Long)
    If IsEmpty(targ) Then
        ReDim targ(1 To 1)
    End If
    yt = yt + 1
    If UBound(targ) < yt Then
        ReDim Preserve targ(1 To 2 * UBound(targ))
    End If
    
    Dim sourRow As Variant
    ReDim sourRow(2 To UBound(sour, 2))
    Dim xs As Long
    For xs = LBound(sourRow) To UBound(sourRow)
        sourRow(xs) = sour(ys, xs)
    Next
    
    targ(yt) = sourRow
End Sub