Tente algo assim. É importante que a série de 3 permaneça a mesma para os tyhis funcionarem.
Sub SingleRow()
Range("A2").Select
Do
Selection.Cut
ActiveCell.Offset(-1, 1).Select
ActiveSheet.Paste
ActiveCell.Offset(1, -1).Select
ActiveCell.EntireRow.Select
ActiveCell.EntireRow.Delete
ActiveCell.Cut
ActiveCell.Offset(-1, 2).Select
ActiveSheet.Paste
ActiveCell.Offset(1, -2).Select
ActiveCell.EntireRow.Select
ActiveCell.EntireRow.Delete
ActiveCell.Offset(1, 0).Select
Loop Until ActiveCell.Value = "" And ActiveCell.Offset(-1, 0).Value = ""
End Sub
Eu testei e isso deve funcionar.