Excel Remove Double Blank Rows

Sub FindDoubleBlank()
    While ActiveCell.Row > 1
        If ActiveCell.Value = "" And ActiveCell.Offset(-1, 0).Value = "" Then
            ActiveCell.EntireRow.Delete
        End If
        ActiveCell.Offset(-1, 0).Activate
    Wend
End Sub