Excelマクロ＠縦に連続する空白の削除(ページ全体)

Sub deleteRows()
    With ActiveSheet
        cntC = .Cells(1, Columns.Count).End(xlToLeft).Column
        
        For col = cntC To 1 Step -1
            cntR = .Cells(Rows.Count, col).End(xlUp).Row
            For Row = cntR To 2 Step -1
                If .Cells(Row, col) = "" And .Cells(Row - 1, col) = "" Then
                .Cells(Row, col).Delete
                Stop
                End If
                
            Next Row

        Next col
    End With
    MsgBox "処理終了〜！"
End Sub