­ã´£³¡ªL

Sub TEST()
Dim xArea As Range, xU As Range, xR As Range
Set xArea = Intersect(ActiveSheet.UsedRange, [B:F])
Set xU = xArea(xArea.Rows.Count + 1, 1)
For Each xR In xArea
    If xR.Column Mod 2 Or xR & xR(1, 2) <> "" Then GoTo 101
    Set xU = Union(xU, xR, xR(1, 2))
101: Next
If xU.Count > 1 Then xU.Delete Shift:=xlUp
End Sub