Sub Perenos()
    Dim lD&, i
    lD = Left(Date, 2)
For i = 9 To Cells(Rows.Count, 4).End(xlUp).Row
    Cells(i, lD + 5).Value = Cells(i, 4).Value
    Cells(i, 4).ClearContents
Next i
End Sub

Sub Test()
    Dim iCell As Long, i As Long, j As Long, Priznak
    Priznak = Array("c", "a")
    
    For i = 0 To UBound(Priznak)
     For iCell = 1 To Cells(Rows.Count, 1).End(xlUp).Row
         j = Sheets("Лист2").Cells(Rows.Count, 1).End(xlUp).Row
      If Cells(iCell, 1) = Priznak(i) Then
         Rows(iCell).Copy Sheets("Лист2").Rows(j + 1)
      End If
     Next iCell
    Next i
End Sub

Range("A1") = Right(Str, Len(Str) - 6)

Range(Cells(i + 1, 2), Cells(j - 1, 2)).Select 

=ВПР(A4;H:I;2;0)

Dim lrow
Dim lcol
Dim r
lrow = ActiveCell.Row
lcol = ActiveCell.Column
r = 3
Range(Cells(lrow, lcol), Cells(lrow, lcol + r - 1)).Value = "Первый"