Не получается с циклом

[armagedon_atyrau]

Здравствуйте Всем!!!
Одну задачу не могу никак сделать.Целый день голову ломил но все равно не получается. Есть такой макрос который значение D(2), D(3) записывает на ячеики по циклу. Теперь хочу что бы значение D(1) записался на другой Sheet. Щас данный момент он мен выдает сообщение этих значении а мне нужно их записать. В коментах написал но он только одно значение записывает. Помогите пожалуйста.

Sub TEL(D As Variant)
Dim r, Adr As String
Dim rw, i As Integer
Dim NewSheet As Worksheet
'Dim NewStr As Range

With Sheets(1)

.UsedRange.AutoFilter
.UsedRange.AutoFilter Field:=1, Criteria1:=D(1)
Adr = Sheets(1).UsedRange.SpecialCells(xl CellTypeVisible).Address
r = Split(Adr, "$", -1)
rw = r(UBound(r))

If rw = 1 Then GoTo 2

.Cells(rw, 3) = D(2)
.Cells(rw, 4) = D(3)
.Cells(rw, 5) = D(4)
.Cells(rw, 6) = D(5)
.Cells(rw, 7) = D(6)
.Cells(rw, 8) = D(7)
.Cells(rw, 9) = D(8)
.Cells(rw, 10) = D(9)
.Cells(rw, 11) = D(10)
.Cells(rw, 12) = D(11)
.Cells(rw, 13) = D(12)
.Cells(rw, 14) = D(13)
.Cells(rw, 15) = D(14)
.Cells(rw, 16) = D(15)
.Cells(rw, 17) = D(16)
'.Cells(rw, 18) = D(1)
.UsedRange.AutoFilter
End With
Exit Sub
2
Sheets(1).UsedRange.AutoFilter
'MsgBox (D(1) & "not found")

'Application.Sheets(2).Cells(1) = D(1)

End Sub

[SAS888]

Во-первых, Ваш макрос можно немного оптимизировать, например, так:

Sub TEL(D As Variant)
    Dim rw As Integer, i As Integer: Application.ScreenUpdating = False
    With Sheets(1)
        .UsedRange.AutoFilter: .UsedRange.AutoFilter Field:=1, Criteria1:=D(1)
        rw = Cells(Rows.Count, 1).End(xlUp).Row
        If rw <> 1 Then
            For i = 3 To 17: .Cells(rw, i) = D(i - 1): Next
            .UsedRange.AutoFilter
        Else
            .UsedRange.AutoFilter
            MsgBox (D(1) & " not found")
            Sheets(2).Cells(1) = D(1)
        End If
    End With
End Sub

Во-вторых, не понятно, что и куда Вам нужно записывать, если значения критерия фильтра отсутствуют. Сейчас просто выводится сообщение и в ячейку "A1" 2-го листа записывается значение D(1). А что нужно?

P.S. Обратите внимание на правильное описание типов переменных.

[armagedon_atyrau]

SAS888 Спасибо Вам что откликнулись на мою задачу. Но я уже сделал вот таким образом

Application.Sheets(1).UsedRange.Aut oFilter
Application.Sheets(2).Range("A" & Application.Sheets(2).Rows.Count).E nd(xlUp).Offset(1) = D(1)