Dim rCol As Range, rDel As Range
For Each rCol In Range("A2:BZ10001").Columns
If Application.WorksheetFunction.CountBlank(rCol) = rCol.Rows.Count Then
If rDel Is Nothing Then
Set rDel = rCol
Else
Set rDel = Union(rDel, rCol)
End If
End If
Next rCol
Set rCol = Nothing
If Not rDel Is Nothing Then
rDel.EntireColumn.Delete
Set rDel = Nothing
End If
End Subcitovat