Excel - Macro Borrado de lineas que no cumplan

Sub Borrar()

    Dim Linea As Long, Blancos As Byte, a As Byte, Num As Byte

    Linea = 1

    Do While True

       If Cells(Linea, 1) = "" Then

          ' --- Si debajo tiene 10 lineas en blanco finaliza

          Num = 0

          For a = Linea + 1 To Linea + 10

              If Cells(a, 1) = "" Then Num = Num + 1

          Next

          If Num = 10 Then Exit Do

          ' --- Si la Anterior y posterior estan vacias la borro

          If Cells(Linea - 1, 1) = "" And Cells(Linea + 1, 1) = "" Then

             Rows(Linea & ":" & Linea).Select

             Selection.Delete Shift:=xlUp

             Linea = Linea - 1

          End If

       End If

       Linea = Linea + 1

    Loop

End Sub