Sub dele()
Dim Clmn As Long
Range("A1").Activate
Clmn = ActiveCell.Column
Application.ScreenUpdating = False
Columns(Clmn).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End Sub
Sub Test()
Dim r As Range
Dim c As Range
Dim d As Range
On Error Resume Next
Set r = Columns(1).SpecialCells(xlCellTypeBlanks)
On Error GoTo 0
If r Is Nothing Then
MsgBox "削除すべきデータがありません"
Exit Sub
End If
For Each c In r
If Not c.MergeCells Then
If d Is Nothing Then
Set d = c
Else
Set d = Union(d, c)
End If
End If
Next