delete, copy, paste within limits

Sub FillColBlanks()
'http://www.contextures.com/xlDataEntry02.html
'by Dave Peterson  2004-01-06
'fill blank cells in column with value above


'2010-10-12 incorporated Ron de Bruin's test for special cells limit
'http://www.rondebruin.nl/specialcells.htm


Dim wks As Worksheet
Dim rng As Range
Dim rng2 As Range
Dim LastRow As Long
Dim col As Long
Dim lRows As Long
Dim lLimit As Long


Dim lCount As Long
On Error Resume Next
 
lRows = 2 'starting row
lLimit = 8000


Set wks = ActiveSheet
With wks
   col = ActiveCell.Column


   Set rng = .UsedRange  'try to reset the lastcell
   LastRow = .Cells.SpecialCells(xlCellTypeLastCell).Row
   Set rng = Nothing
   
    lCount = .Columns(col).SpecialCells(xlCellTypeBlanks).Areas(1).Cells.Count
    
    If lCount = 0 Then
        MsgBox "No blanks found in selected column"
        Exit Sub
    ElseIf lCount = .Columns(col).Cells.Count Then
        MsgBox "Over the Special Cells Limit" 'this line can be deleted
        Do While lRows < LastRow
            Set rng = .Range(.Cells(lRows, col), .Cells(lRows + lLimit, col)) _
                           .Cells.SpecialCells(xlCellTypeBlanks)
            rng.FormulaR1C1 = "=R[-1]C"
            lRows = lRows + lLimit
        Loop
    Else
        Set rng = .Range(.Cells(2, col), .Cells(LastRow, col)) _
                       .Cells.SpecialCells(xlCellTypeBlanks)
        rng.FormulaR1C1 = "=R[-1]C"
    End If


   'replace formulas with values
   With .Cells(1, col).EntireColumn
       .Value = .Value
   End With


End With


End Sub