Tidying up code

[litestream]

    Range("C6").Select
    Selection.Cut Destination:=Range("D5")
    Range("C8").Select
    Selection.Cut Destination:=Range("D7")
    Range("C11").Select
    Selection.Cut Destination:=Range("D10")
    Range("C13").Select
    Selection.Cut Destination:=Range("D12")
    Range("C16").Select
    Selection.Cut Destination:=Range("D15")
    Range("C18").Select
    Selection.Cut Destination:=Range("D17")
    Range("C21").Select
    Selection.Cut Destination:=Range("D20")
    Range("C23").Select
    Selection.Cut Destination:=Range("D22")

I have to continue this code up to about 2000 lines. Is there anyway to tidy up the code bearing in mind that one line is 2 more than the one above then the next line is 3 more than that?

Any assistance would be greatly appreciated.

 

[Dylan]

Try this.

For I = 1 To 10 
Range("C" & 1 + I * 5).Cut Destination:=Range("D" & I * 5)
Range("C" & 3 + I * 5).Cut Destination:=Range("D" & 2 + I * 5)
Next I

 

[Lewiy]

Give this a try:

Dim Limit As Long
Dim c As Long
Dim flag As Boolean
Limit = Cells(Rows.Count, 3).End(xlUp).Row
flag = False
c = 6
While c <= Limit
    Cells(c, 3).Cut Destination:=Cells(c - 1, 4)
    If flag = False Then
        c = c + 2
        flag = True
        Else
            c = c + 3
            flag = False
    End If
Wend

 

[Boller]

Dim rng As Range, x#
Set rng = Range([C6], [C65536].End(xlUp))
For x = 1 To rng.Cells.Count Step 5
    rng(x).Cut rng(x - 1, 2)
    rng(x + 2).Cut rng(x + 1, 2)
Next

 

[litestream]

Perfect, thanks all.

 

[litestream]

Similarly, how would I tidy up the following?
How do I refer to rows using For and Next loops?

    Rows("6:6").Select
    Selection.Delete Shift:=xlUp
    Rows("7:8").Select
    Selection.Delete Shift:=xlUp
    Rows("8:8").Select
    Selection.Delete Shift:=xlUp
    Rows("9:10").Select
    Selection.Delete Shift:=xlUp
    Rows("10:10").Select
    Selection.Delete Shift:=xlUp
    Rows("11:12").Select

 

[Lewiy]

Perhaps like this?:

Dim Limit As Long
Dim c As Long
Limit = Cells(Rows.Count, 1).End(xlUp).Row
For c = Limit To 6 Step -1
    If (c / 3) = Int(c / 3) Or ((c + 1) / 3) = Int((c + 1) / 3) Then
        Rows(c).Delete shift:=xlUp
    End If
Next c

 

[Boller]

Dim rng As Range, x#, rng2 As Range
Set rng = Intersect([A6:A65536], ActiveSheet.UsedRange.EntireRow)
Set rng2 = rng(1)
For x = 6 To rng.Cells.Count Step 5
    Set rng2 = Union(rng2, rng(x))
Next
For x = 3 To rng.Cells.Count Step 5
    Set rng2 = Union(rng2, rng(x).Resize(2))
Next
rng2.EntireRow.Delete