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