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

Sub разброс()
    LastRow = Cells(Rows.Count, 1).End(xlUp).Row    ' количество строк в диапазоне

' цикл перебора значений в диапазоне и действий над ними
    For i = 1 To LastRow
        If Cells(i, 3).Value < 0 Then
            Cells(i, 4) = 0
        Else
            Cells(i, 4) = Cells(i, 3).Value
        End If
    Next i
End Sub

 Worksheets("Îáùèå ñïèñêè").Shapes.Range(Array("Picture 1")).PickUp
 ActiveSheet.Shapes.Range(Array("Picture 36")).Apply

Private Sub cmdDrob_Click()
    If Len(ActiveControl) = 0 Then Exit Sub
    If Len(ActiveControl) - Len(Replace(ActiveControl, ",", "")) > 0 Then Exit Sub
    ActiveControl = ActiveControl & ","
End Sub