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

Sub test()
    lr = 2
    Call subtest(lr)
    MsgBox (lr)
End Sub

Sub subtest(lr)
    lr = 3
End Sub

Option Explicit
Private Sub Worksheet_Activate()
    Dim arr_in
    Dim tabl As Object
    
    arr_in = Sheets(1).Range("Òàáëèöà1").Value
    Set tabl = Sheets(2).ListObjects("Òàáëèöà2")
 
    If Not tabl.DataBodyRange Is Nothing Then tabl.DataBodyRange.ClearContents
    tabl.Resize tabl.Range.Resize(UBound(arr_in) + 1)
    tabl.DataBodyRange.Value = arr_in
End Sub