Из столбца в строчку с условием!

[Vladimir17M]

Здравствуйте! Помогите с макрос чтобы он переносил значения из 1 столбца 1 листа в 1 строчку 2 листа, но при этом миновал пустые ячейки.
Пример:
A
1 100
2 0
3 0
4 400
Лист 1

Результат:

А B C D
1 100 400
Лист 2

Где-то так)))

[Hugo121]

Sub tt()
For Each cc In [a2:a100]
If cc.Value > 0 Then
i = i + 1
Cells(1, i) = cc.Value
End If
Next
End Sub

Данные с А2.
Количество не отслеживается!
Листы тоже

С листами так (данные с А1):

Sub tt()
For Each cc In Sheets(1).[a1:a100]
If cc.Value > 0 Then
i = i + 1
Sheets(2).Cells(1, i) = cc.Value
End If
Next
End Sub

[Vladimir17M]

Все здорово только есть еще условия про которое я забыл за что извиняюсь.
Условие такое не должно быть повторных значений в ячейках в горизонтальном столбце.

[Hugo121]

Тогда сперва в словарь, потом его на лист.

[Vladimir17M]

Не понял я сейчас, в какой словарь?

[Hugo121]

Поищите по "Dictionary" или "Collection" - это коллекция, тоже можно...

[Hugo121]

Добил, с выгрузкой застрял:

Option Explicit
Sub otbor()

    Dim a(), oDict As Object, i As Long, Temp As String

    a = Sheets(1).Range("A1:A" & Sheets(1).Range("A" & Rows.Count).End(xlUp).Row).Value
    Set oDict = CreateObject("Scripting.Dictionary")
    For i = 1 To UBound(a)
        Temp = Trim(a(i, 1))
        If Temp <> "0" Then
        If Not oDict.Exists(Temp) Then oDict.Add Temp, CStr(1)
        End If
    Next

    With ThisWorkbook.Worksheets(2)
        .Range("A1").Resize(, oDict.Count).Value = oDict.keys
    End With

End Sub

Только тут нет проверки на количество столбцов - если данных наберётся больше, будет ошибка!

[Vladimir17M]

Спасибо Hugo121 Все работает отлично!