tabl.DataBodyRange.Value = rezult  'Value2/Formula

        For i = LBound(rezult) To UBound(rezult)
            For n = LBound(rezult, 2) To UBound(rezult, 2)
                .DataBodyRange.Cells(i, n).Value = rezult(i, n)
            Next n
        Next i

arr_data = .GetRows

            ' transpose array  -----------------------------------
            ReDim arr_transposed_data(1 To UBound(arr_data, 2) + 1, 1 To UBound(arr_data) + 1)
            For i = LBound(arr_transposed_data) To UBound(arr_transposed_data)
                For n = LBound(arr_transposed_data, 2) To UBound(arr_transposed_data, 2)
                    arr_transposed_data(i, n) = arr_data(n - 1, i - 1)
                Next n
            Next i

 tabl.DataBodyRange.Value = rezult

            .DataBodyRange.Resize(UBound(rezult) - LBound(rezult) + 1, UBound(rezult, 2) - LBound(rezult, 2) + 1).Value = rezult

        For i = LBound(rezult) To UBound(rezult)
            For n = LBound(rezult, 2) To UBound(rezult, 2)
                .DataBodyRange.Cells(i, n) = rezult(i, n)
            Next n
        Next i

Sub rrrr(dtime, dname , ddat )
 
gh = (ThisWorkbook.Worksheets("Лист4").UsedRange.Row - 1 + ThisWorkbook.Worksheets("Лист4").UsedRange.Rows.Count) + 1
Set wdat = ThisWorkbook.Worksheets("Лист4").Cells(gh, 1)
Set wtime = ThisWorkbook.Worksheets("Лист4").Cells(gh, 2)
Set wname = ThisWorkbook.Worksheets("Лист4").Cells(gh, 3)
Set ganr = ThisWorkbook.Worksheets("Лист4").Cells(gh, 4)
Set wvoz = ThisWorkbook.Worksheets("Лист4").Cells(gh, 5)
Set wanot = ThisWorkbook.Worksheets("Лист4").Cells(gh, 6)
 
If dtime.Value > 0 Then
   wtime.Value = dtime
   wname.Value = dname
   wdat.Value = ddat.Value
i = dname
j = Application.Match(i, [Название], 0)
wvoz.Value = Application.Index([ОписаниеПрограмм], j, 2)
ganr.Value = Application.Index([ОписаниеПрограмм], j, 3)
wanot.Value = Application.Index([ОписаниеПрограмм], j, 4)

End sub

Sub cycler ()

Set dtime = ThisWorkbook.Worksheets("Эфирная сетка").Cells(con1, 2)
Set dname = ThisWorkbook.Worksheets("Эфирная сетка").Cells(con1, 4)
Set ddat = ThisWorkbook.Worksheets("Эфирная сетка").Cells(1, 2)

Call rrrr(dtime, dname , ddat )

Set dtime = ThisWorkbook.Worksheets("Эфирная сетка").Cells(con2, 8)
Set dname = ThisWorkbook.Worksheets("Эфирная сетка").Cells(con2, 10)
Set ddat = ThisWorkbook.Worksheets("Эфирная сетка").Cells(1, 8)
Call rrrr(dtime, dname , ddat )
'....
End sub

Sub Расчет()

Range("f3:f7").Formula = "=1/d3*100"
'если нужно заменить формулы на значения, то добавить
Range("f3:f7").Value = Range("f3:f7").Value

End Sub

 .DataBodyRange.Resize(UBound(rezult), UBound(rezult, 2)).Value = rezult

    Table.DataBodyRange.Rows(1).ClearContents
    Table.DataBodyRange.Offset(1, 0).Resize(Table.DataBodyRange.Rows.Count - 1, _
    Table.DataBodyRange.Columns.Count).Rows.Delete

                        Do While .ListRows.Count > rows_count
                            .ListRows(.ListRows.Count).Delete
                            Loop

  .DataBodyRange.Rows.Delete
  .ListRows.Add
  .DataBodyRange.Resize(UBound(rezult), UBound(rezult, 2)).Value = rezult

a = Format(Now(), "dd/mm/yyyy hh:nn:ss:ms")

CurDate = MAX('MyCalendar'[Date])

Таблица = Var vrows = FILTER('Таблиця1'; .'Таблиця1'[Date] < DATE(2019; 4; 21))

Sub Test()
    Dim iCell As Range, Priznak As Variant
    Priznak = Application.InputBox("признак переноса сроки", "Екатеринбург", "Екатеринбург")
    Priznak = Split(Priznak, ",")

    For Each iCell In Range("A2", [A2].End(xlDown))
        For i = lbound(Priznak) To Ubound(Priznak)
            If iCell = Priznak(i) Then
                With Sheets("ЕКБ")
                    iCell.EntireRow.Copy Destination:=.Cells(.Cells(Rows.Count, "A").End(xlUp).Row + 1, "A")
                End With
            End If
        Next i
    Next iCell
    MsgBox "строки скопированы на другой лист", vbInformation, ""
End Sub