CALCULATE('Индекс ММВБ'[_Мера_ММВБ Среднее], DATEADD('яКалендарь'[Date],-12,MONTH)) 

= Table.SelectRows(#"Строки с примененным фильтром2", each not Text.Contains([Аналитика Дт.2], "Продажа"))

_Мера_Денежный_поток_для карточки_в млн = 
CALCULATE('ОДДС'[_Мера_Денежный_поток_в млн], 
        FILTER('яКалендарь',
        'яКалендарь'[Date]<=EOMONTH('Фин модель'[_Мера_Отчетный месяц в PL],0))) 

=(НАИБОЛЬШИЙ((C3:I3<>B4:B10)*(C4:I10); 3))

Мера_Ср_ЗП_6мес = CALCULATE(AVERAGE('Средняя_ЗП_Россия'[средняя зарплата (брутто), руб.]), 
FILTER('яКалендарь', 'яКалендарь'[Date]<=MAX('яКалендарь'[Date]) && 'яКалендарь'[Date]>=DATEADD('яКалендарь'[Date],-6,MONTH)))

Sub Udalenie_Skrytyh_Strok()
Dim sh As Worksheet
Dim rng As Range, gr As Range
Dim t!, r&, AC&, n&
 
Application.DisplayAlerts = False
Application.ScreenUpdating = False
AC = Application.Calculation: Application.Calculation = xlCalculationManual
  
    For Each sh In ActiveWorkbook.Worksheets
    If sh.Name <> "Остатки" And sh.Name <> "Контракты" And sh.Name <> "Покупатели" And sh.Name <> "Склады" And sh.Name <> "Категории" And sh.Name <> "Панель менеджера" And sh.Name <> "Доставка" Then

        For r = sh.UsedRange.Row To sh.UsedRange.Row + sh.UsedRange.Rows.Count - 1
            If sh.Rows(r).Hidden Then
                n = n + 1
                Set rng = Intersect(sh.Rows(r), sh.ListObjects(1).DataBodyRange)
                If gr Is Nothing Then Set gr = rng Else Set gr = Application.Union(gr, rng)
            End If
        Next r
  
        If Not gr Is Nothing Then
            gr.Delete
            Set gr = Nothing
        End If
             End If
    Next sh
 
Application.Calculation = AC
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

Sub Save_Copy_As()
    Const sPath_in_Names = "Path4SaveCopyAs"   ' имя элемента коллекции .Names, в котором должен храниться путь для сохранения копий файла
    Dim sSuff$: sSuff = " [" & Format(Now, "yyyy/mm/dd hh-mm'ss''") & "]"    ' суффикс к имени файла копии - дата и время сохренения копии файла
    Dim FileName, sExp$, sDirPath$, sFullFilePath$, sNewPath$
    Dim bReadOnlyRecommended As Boolean
    With ActiveWorkbook
        FileName = .Name   ' например, "Книга1.xls"
        sExp = ".xlsx" 'Right(FileName, Len(FileName) - InStrRev(FileName, ".") + 1)   ' расширение файла вместе с точкой (например, ".xls")
       ' FileName = Left(FileName, Len(FileName) - Len(sExp)) & sSuff & sExp   ' например, "Книга1 [2012.02.06 15-24'39''].xls"
        FileName = "Бланк заказа " & sSuff & sExp
        On Error Resume Next
        sDirPath = .Names(sPath_in_Names).Value   ' считать из коллекции .Names значение, ранее сохраненное под именем sPath_in_Names
        If Err Then .Names.Add sPath_in_Names, .Path & "\": sDirPath = .Names(sPath_in_Names).Value   ' если считать не удалось, значит путь ранее не задавался и он для первого раза задаётся равным ActiveWorkbook.Path
        sDirPath = Mid(sDirPath, 3, Len(sDirPath) - 3)   ' убрать из считанного значения в начале "= и в конце "
        sDirPath = sDirPath & IIf(Right(sDirPath, 1) = "\", "", "\")  ' на всякий случай (если имя было задано в ручную и при этом не верно - без слэша)
        .Names(sPath_in_Names).Value = sDirPath   ' запомнить путь сохранения копий в коллекции .Names под именем sPath_in_Names
        sFullFilePath = sDirPath & FileName   ' полный путь сохранения вместе с полным именем копии
REPEAT_:
        FileName = Application.GetSaveAsFilename(InitialFileName:=sFullFilePath, _
                    FileFilter:="Excel Files (*" & sExp & "), *" & sExp & ", All Files (*.*),*.*", _
                    Title:="Сохранение копии файла")   'задать путь сохранения и имя копии файла в окне выбора
        If VarType(FileName) = vbBoolean Then Exit Sub   ' если нажали "Отмена", то FileName = False, если "Сохранить" - полный путь к файлу вместе с его именем
        If FileName = .FullName Then MsgBox "Здесь нельзя сохранить файл под таким именем!", 16, "Ошибка": GoTo REPEAT_
        sDirPath = Left(FileName, InStrRev(FileName, "\"))   ' путь к папке сохранения копий без имени файла
        .Names(sPath_in_Names).Value = sDirPath   ' запомнить выбранный в диалоге путь в коллекции .Names под именем sPath_in_Names
        bReadOnlyRecommended = .ReadOnlyRecommended   ' запомнить параметры исходного файла
       ' .ReadOnlyRecommended = --(MsgBox("Рекомендовать открывать файл только для чтения?", 36) - 7)   ' MsgBox Argument 4==vbYesNo 32==vbQuestion, MsgBox Return Values: vbYes=6, vbNo=7
        .SaveAs FileName, FileFormat:= _
        xlOpenXMLWorkbook, CreateBackup:=False
        '.ReadOnlyRecommended = bReadOnlyRecommended   ' восстановить параметры исходного файла
    End With
End Sub

Sub Удалить_Скрытые_строки()

ActiveSheet.AutoFilter.Range.Offset(1).SpecialCells(xlCellTypeVisible).EntireRow.Delete
ActiveSheet.AutoFilterMode = False
    
End Sub

Sub Изменить_Размер_Таблицы()

Dim ws As Worksheet
Dim tabl As ListObject
'Запускаем цикл через каждый лист книги
For Each ws In ThisWorkbook.Worksheets

'убираем из цикла ненужные листы
If ws.Name <> "Остатки" And ws.Name <> "Контракты" And ws.Name <> "Покупатели" And ws.Name <> "Доставка" Then

'Запускаем цикл через все умные таблицы
For Each tabl In ws.ListObjects

'LastRow = ActiveSheet.UsedRange.Row + ActiveSheet.UsedRange.Rows.Count
LastRow = ws.Cells(Rows.Count, 2).End(xlUp).Row 'определяем последний ряд
LastColumn = ws.UsedRange.Column + ws.UsedRange.Columns.Count - 1 'определяем последний столбец
    Application.ScreenUpdating = False
   
    ws.ListObjects(1).Resize Range(Cells(20, 11), Cells(LastRow, LastColumn)) 'изменяем размер таблицы под размер сводной
    
    ws.Range(Cells(LastRow + 1, 11), Cells(LastRow + 100000, LastColumn)).Clear 'удаляем остатки от предыдущей умной таблицы
      
    
Next tabl
End If
Next ws
    
End Sub

ws.Range(Cells(LastRow + 1, 11), Cells(LastRow + 100000, LastColumn)).Clear 

Мера_Выработка_YoY, ед. = CALCULATE(
SUM('ДанныеДиспетчера'[выработка, ед.]), 
DATEADD('яКалендарь'[Date],-1,YEAR),
FILTER('ДанныеДиспетчера', 'ДанныеДиспетчера'[период]<=MAX('ДанныеДиспетчера'[период])))

Таблица = SUMMARIZECOLUMNS('Реестр_диспетчера'[Дата снятия], 'Реестр_диспетчера'[Код об’єкта], "temp_Гкал", SUM('Реестр_диспетчера'[Гкал]))

_Мера_Гкал_Средняя2 = AVERAGEx('Таблица',[temp_Гкал])

_Мера_Гкал_Средняя = 
AVERAGEx(
  SUMMARIZECOLUMNS('Реестр_диспетчера'[Дата снятия], 'Реестр_диспетчера'[Код об’єкта], "temp_Гкал", SUM('Реестр_диспетчера'[Гкал])),
  [temp_Гкал])

Мера_ЧистПр_Откл% = IF(ISFILTERED('яСтатьи_1ур'), 
    DIVIDE('_Меры'[Мера_ЧистПр_Откл], '_Меры'[Мера_ЧистПр_План],0),
BLANK())

LastRow = ActiveSheet.UsedRange.Row + ActiveSheet.UsedRange.Rows.Count 'определяем последний ряд
LastColumn = ActiveSheet.UsedRange.Column + ActiveSheet.UsedRange.Columns.Count - 1 'определяем последний столбец
    Application.ScreenUpdating = False
    y = LastRow
      ActiveSheet.ListObjects("Касса").Resize Range(Cells(2, 1), Cells(y, LastColumn)) 'добавляем новую строку

Мера_Оборачиваемость_Заказа = 
var Dni = max('Заказы_Свод'[Оборачиваемость заказа])
return
if (Dni=BLANK(), "не готов", Dni)

Мера_Дз_Покупатели_Сальдо2 = 
    SUMX(VALUES('Даты снятия счетчиков_Свод'[Контрагент]),
    VAR Dz = 
     CALCULATE(SUM('Даты снятия счетчиков_Свод'[Сумма с НДС]), ALL('яСправочник_Календарь'))
     - CALCULATE(SUM('Счет_Карточка_31_ДС'[Кредит_оборот]), ALL('яСправочник_Календарь'))
    RETURN
        IF( Dz < 10, 0, Dz/1000))