Sub Macro1() Dim rg As Range For Each rg In [a1:a500] If rg = "" Then rg.Delete shift:=xlUp End If Next End Sub