Sub DeleteBlanks() Dim lRow As Long With ThisWorkbook.ActiveSheet.UsedRange lRow = .Cells.SpecialCells(xlCellTypeLastCell).Row .Range("A1:A" & lRow).SpecialCells(xlCellTypeBlanks).EntireRow.Delete End With End Sub