Копирование и вставки строки - VBA

Формулировка задачи:

Здравствуйте! Столкнулась с проблемой. Написала цикл на поиск непустых строк со значением не 0, а дальше они должны копироваться на другой лист ("Лист2"). Проблема в том, что вставляется только первая строка. А цикл проходит правильно (порядок последней выделенной строки на листе 2 по завершении программы соответствует количеству строк, которые необходимо скопировать). Бьюсь над решением проблемы! Не вижу ошибки

Sub Кнопка115_Щелчок()
Dim ra As Range
Dim rng As Range
Dim d, i As Long
d = 1
i = 1
 Set rng = Sheets("Таблица остатков").Range([P1], Range("P" & Rows.Count).End(xlUp))
   For Each ra In rng
   If ra.Value <> "0" And Len(ra) <> 0 Then
   Range("B" & i, "S" & i).Select
   Selection.Copy
   Sheets("Лист2").Select
   'Sheets("Лист2").Paste(Sheets("Таблица остатков").range[("A" & d), missing]
   Range("A" & d).Select 'Выделили
   Sheets("Лист2").Paste 'Вставили
   d = d + 1
  End If
   i = i + 1
   Next ra
End Sub

спасибо!

Решение задачи: «Копирование и вставки строки»

textual
                            Листинг программы 
                        

                            Sub Кнопка115_Щелчок()
   Dim ra As Range
   Dim rng As Range
   Dim d As Long, i As Long
   d = 1
   i = 1
   Set rng = Sheets("Таблица остатков").Range(Range("P1"), Range("P" & Rows.Count).End(xlUp))
   For Each ra In rng
      If ra.Value <> "0" And Len(ra) <> 0 Then
         Range("B" & i, "S" & i).Select 'Выделили на активном листе диапазон для копирования.
         Selection.Copy 'Копируем его.
         Sheets("Лист2").Select 'Выделили лист "Лист2" (теперь активен лист "Лист2").
         Range("A" & d).Select 'Выделили на активном листе ячейку, начиная с которой производится вставка.
         Sheets("Лист2").Paste 'Вставили на "Лист2" копируемый диапазон.
         '----Строка, которой не хватает----
         Sheets("Таблица остатков").Select 'Выделили лист "Таблица остатков" (теперь он снова активен).
         '----------------------------------
         d = d + 1
      End If
      i = i + 1
   Next ra
End Sub
                        