Cannot get my excel loop to move to the next cycle

[webbk22]

I want my Macro to loop every 3rd row.  Here is the code I am using. It will run through the code find perform the functions great on the first pass, but on the second pass, the loop moves back to ("A1:B1")

Sub Module2()
Dim i As Integer
NumRows = Range("A1", Range("A1").End(xlDown)).Rows.Count
Range("A1").Select
 

  For i =1 To IsEmpty(ActiveCell)
  

Range("A1:B1").Select
    Selection.Delete Shift:=xlToLeft
    Range("A2:D2").Select
    Selection.Cut
    Range("B1").Select
    ActiveSheet.paste
    Range("A3").Select
    Selection.Cut
    Range("F1").Select
    ActiveSheet.paste
    ActiveCell.Offset(3, -5).Select
  Loop
    End Sub


Public Sub blanks()
 Selection.SpecialCells(xlCellTypeBlanks).Select
    Selection.Delete Shift:=xlUp
End Sub

[#2]

@webbk22 

I don't see how this code could run at all - it is both syntactically and logically incorrect.

What is it supposed to do?

[#3]

@webbk22  It appears that you want to loop through the cells, in blocks of 3, delete the first cell (column A & B, shifting to the left), move the second cell over one column (to B), and move the third cell over six columns (to F)?

If so, you could try this (be sure to back up your data first as you can't undo a vba action):

Sub Module2()
     Dim i As Long
     Dim rng As Range
     
     Set rng = Range("A1", Range("A1").End(xlDown))
     
     With rng
          If .Rows.Count Mod 3 > 0 Then Exit Sub
     
          For i = rng.Rows.Count To 1 Step -3
               .Cells(i, 1).Cut .Cells(i, 1)(1, 6)
               .Cells(i - 1, 1).Cut .Cells(i - 1, 1)(1, 2)
               .Cells(i - 2, 1).Resize(1, 2).Delete shift:=xlToLeft
          Next i
     End With

End Sub