Sub Plan_Fact()

    Const shablon_sh As String = "шаблон" 'название листа с шаблоном копируемых строк
    Const shablon_rng As String = "I6:AN7" 'диапазон шаблона копируемых строк
    Dim shablon_range As Range
    Set shablon_range = ThisWorkbook.Worksheets(shablon_sh).Range(shablon_rng)
    
    Const cell_plan_fact As String = "I" ' столбец  План/факт для старта копирование

    Const merged_cells As String = "B:H" ' столбцы объединения ячеек
    Const n_rows As Long = 1 ' кол-во строк добавления и объединения после каждой
    
    Dim src_rng As Range
    On Error Resume Next
    Set src_rng = Application.InputBox("Выбрать стартовую ячейку", Type:=8) ' выбор крайней левой верхней ячейки таблицы
    On Error GoTo 0
    If src_rng Is Nothing Then
        MsgBox "не выбрана ячейка"
        Exit Sub
    End If
    
    
    With Application
        .ScreenUpdating = False
        .Calculation = xlCalculationManual
        .DisplayAlerts = False
    End With
    
    Dim lastRow As Long, i As Long
    Dim rng As Range
    With ActiveSheet
        lastRow = .Cells(.Rows.Count, src_rng.Column).End(xlUp).Row
        For i = lastRow To src_rng.Row Step -1
            With .Cells(i, src_rng.Column)
                .Offset(1).Resize(n_rows).EntireRow.Insert Shift:=xlShiftDown
            End With
            shablon_range.Copy .Cells(i, cell_plan_fact)
            For Each rng In Intersect(.Cells(i, src_rng.Column).Resize(n_rows + 1).EntireRow, .Range(merged_cells)).Columns
                rng.Merge
                rng.BorderAround xlContinuous
            Next rng
        Next i
    End With
    
    With Application
        .CutCopyMode = False
        .ScreenUpdating = True
        .Calculation = xlCalculationAutomatic
        .DisplayAlerts = True
    End With
       
End Sub

Public ID As String
Private pValues As Variant

' Публичное свойство для чтения массива
Public Property Get Values() As Variant
    Values = pValues
End Property

' Публичное свойство для записи массива
Public Property Let Values(ByVal arr As Variant)
    pValues = arr
End Property

_Sum:=
=var _client = VALUES('Таблица1'[Клиент])
var _result = SUMX(_client; 
         var _tab = CALCULATETABLE('Таблица1'; 
                  'Таблица1'[Анкета]= BLANK() ;
                   NOT 'Таблица1'[Тип дистанционной заявки]  IN {"Сайт";  "Яндекс"}
                )
         var _not_tech = SUMX(FILTER(_tab; 'Таблица1'[Состояние]<>"Технически нет");'Таблица1'[Сумма])
         var _tech = FILTER(_tab; 'Таблица1'[Состояние] = "Технически нет")
         var _cond = COUNTROWS(_tech) > 1
         var _sum_tech = IF(_cond; 
                  var _add= ADDCOLUMNS(_tech; "@MaxDate"; 
                              var _m = MONTH('Таблица1'[Дата создания])
                              var _y = YEAR('Таблица1'[Дата создания])
                              var _f = MAXX(FILTER(_tech; MONTH('Таблица1'[Дата создания]) = _m && YEAR('Таблица1'[Дата создания]) = _y);'Таблица1'[Дата создания])
                              return
                              _f
                        )         
                  var _col = SELECTCOLUMNS( _add;"@M"; [@MaxDate])
                  var _filter_date = DISTINCT( _col)
                  var _res = SUMX(FILTER(_tech;'Таблица1'[Дата создания] IN _filter_date);'Таблица1'[Сумма])
                  return 
                  _res
                  ;
                  0
                  )
                     
         return _not_tech + _sum_tech
      )
return 
_result

Кол-во:=
var _client = VALUES('Таблица1'[Клиент])
var _result = SUMX(_client; 
         var _tab = CALCULATETABLE('Таблица1'; 
                  'Таблица1'[Анкета]= BLANK() ;
                   NOT 'Таблица1'[Тип дистанционной заявки]  IN {"Сайт";  "Яндекс"}
                )
         var _not_tech = COUNTROWS(FILTER(_tab; 'Таблица1'[Состояние]<>"Технически нет"))
         var _tech = FILTER(_tab; 'Таблица1'[Состояние] = "Технически нет")
         var _cond = COUNTROWS(_tech) > 1
         var _count_tech = IF(_cond; 
                  var _add= ADDCOLUMNS(_tech; "@Month"; MONTH('Таблица1'[Дата создания]))
                  var _col = SELECTCOLUMNS( _add;"@M"; [@Month])
                  var _res = COUNTROWS( DISTINCT( _col))
                  return 
                  _res
                  ;
                  0
                  )
                     
         return _not_tech + _count_tech
      )
return 
_result

Private Sub Worksheet_Change(ByVal Target As Range)
    
    Application.EnableEvents = False
    Range("A1").FormulaLocal = "=СЕГОДНЯ()"
    Application.EnableEvents = True

End Sub

let
    src = Excel.CurrentWorkbook(){[Name="Таблица4"]}[Content], 
    col_name = {"П1","П2","П3","П4"},
    add = Table.AddColumn(src,"not_0", (x)=>List.Count(List.Select(Record.ToList(Record.SelectFields(x, col_name)), (x)=> x > 0 )))
in
    add

Sub SaveWebPageToEdisclosureFolder()
    Dim URL As String
    Dim FileName As String
    Dim DateStamp As String
    Dim FolderPath As String
    Dim FilePath As String
    Dim http As Object
    Dim stream As Object
    Dim FSO As Object
    Dim oFolder As Object
 
    ' Адрес сайта
    URL = "https://www.e-disclosure.ru/portal/files.aspx?id=1976&type=3"
 
    ' Формируем отметку времени
    DateStamp = Format(Now, "yyyy-mm-dd_HH-MM-SS")
 
    ' Путь к папке "E-disclosure" на рабочем столе
    FolderPath = Environ("USERPROFILE") & "\Desktop\E-disclosure\"
    FolderPath = ThisWorkbook.Path
     
    ' Проверка и создание папки, если её нет
    Set FSO = CreateObject("Scripting.FileSystemObject")
    If Not FSO.FolderExists(FolderPath) Then
        Set oFolder = FSO.CreateFolder(FolderPath)
    Else
        Set oFolder = FSO.GetFolder(FolderPath)
    End If
 
    ' Полное имя файла
    FileName = "siteДАААААААА_" & DateStamp & ".html"
    FilePath = oFolder.Path & Application.PathSeparator & FileName
 
    ' Загружаем страницу
    Set http = CreateObject("MSXML2.XMLHTTP")
    http.Open "GET", URL, False
    http.Send
 
    ' Проверка статуса и сохранение
    If http.Status = 200 Then
'        Dim txtFile As Scripting.TextStream
'        Set txtFile = FSO.OpenTextFile(FilePath, 2, True, -1)
'        txtFile.Write http.responsetext
'        txtFile.Close
        
        
        Set stream = CreateObject("ADODB.Stream")
        stream.Type = 2 ' text
        stream.Charset = "UTF-8"
        stream.Open
        stream.WriteText http.responsetext
        stream.SaveToFile FilePath, 2 ' 2 = adSaveCreateOverWrite
        stream.Close
        
        MsgBox "Файл успешно сохранён:" & vbCrLf & FilePath, vbInformation
    Else
        MsgBox "Ошибка загрузки страницы. Код: " & http.Status, vbExclamation
    End If
End Sub

<3 мес = 
var _end_year = ENDOFYEAR('Календарь'[Date])
var _min_date = MIN(DATE(2024;09;13);_end_year)
var _tab = CALCULATETABLE('таб'; 'Календарь'[Date]<=_min_date;'таб'[Дата увольнения] = BLANK() ||'таб'[Дата увольнения] > _min_date)
var _result = SUMX(_tab; INT(DATEDIFF([Дата приема]; _min_date;MONTH)<3))
return _result