[vba]

Sub ShowAllItems1()
Dim x As Range
Dim coll As Collection
Dim i As Long

Set coll = New Collection

On Error Resume Next
For Each x In ActiveCell.CurrentRegion

coll.Add x.Value, x.Value
Next
On Error GoTo 0

i = 1
For i = 1 To coll.Count

Cells(4 + i, 7).Value = coll.Item(i)
Next i

End Sub
[/vba]