klen_а вот мой вариантик, правда не такой компактный как у Deggasad, но тоже работает
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
Sub Макрос1()
Dim lst As Range, i, j, RowMax
j = 0
Set lst = ThisWorkbook.Worksheets("Лист1").UsedRange
With lst
RowMax = .Rows.Count + .Row - 1
For i = 1 To RowMax
If (i Mod 4 ) = 0 Then
j = j + 1
.Cells(j, 2 ) = .Cells(i, 1 )
End If
Next
End With
Set lst = Nothing
End Sub
может чего лишнего написал, если не лень подправьте
мне самому интересно, как это код можно написать компактнее?
Лучше скопировать лист, сохранить всё как значения, выделить все строки не удовлетворяющие условию (!только не цикл!) и удалить!
