Sub Macro1()
Dim RngForDelete As Range, i As Long, LastRow As Long
    LastRow = Cells(Rows.Count, 1).End(xlUp).Row 'Нашли номер последней строки по столбцу А
    For i = 3 To LastRow Step 2 'Цикл со строки 3 по последнюю с шагом = 2
        ' Добавляем в диапазон ячейку для удаления
        If RngForDelete Is Nothing Then 'Если диапазон для удаления ещё пуст, тобавляем в него ячейку
            Set RngForDelete = Cells(i, 1)
        Else 'Иначе
            Set RngForDelete = Union(RngForDelete, Cells(i, 1)) 'пополняем диапазон
        End If
    Next
    ' если строки для удаления найдены, то удаляем их
    If Not RngForDelete Is Nothing Then RngForDelete.EntireRow.Delete
End Sub

Sub TestDelete2()
    Columns("A:A").SpecialCells(xlCellTypeBlanks).Select
    Selection.EntireRow.Delete
End Sub