Eugene

DIm DataCell as Range

On Error Resume Next
For Each DataCell in Selection
    If DataCell.Value<>0 Then 'При условии, что значения могут быть только числовые. Иначе делаем проверки или, как я, забиваем на них с помощью On Error Resume Next
        'Приченяем добро: добавляем данные в динамический массив, в коллекцию, в другие ячейки и т.п.
    End If
Next

Sub Macro1()
'
' Macro1 Macro
'

'
    ActiveSheet.Shapes.Range(Array("Drop Down 1")).Select
    With Selection
        .ListFillRange = "$A$1:$A$3"
        .LinkedCell = ""
        .DropDownLines = 8
        .Display3DShading = False
    End With
End Sub