Копирование ячеек с определенной позиции и с одного листа на другой в VBA

Вот такое дали:

Копировать клетки столбца D, начиная с клетки D5, с Листа 2 на Лист 1 до тех пор, пока сумма копируемых значений не станет больше 100.

Решить на VBA, в Excel соответственно.

Задача показалась ну сильно простой, однако, на ее решение ушло значительное время.

Код получился таким:

[VB]

Option Explicit ‘ Обязательное оъявление данных
Sub CopyPrj() ‘ Заголовок программы
‘ Объявление переменных

Dim sum As Single
Dim i As Integer
Dim oRange2  As Range
sum = 0
i = 5
Sheets(«Лист2»).Activate

Do While (sum <= 100)

Set oRange2 = Worksheets(«Лист2»).Cells(i, 4)

oRange2.Select
Selection.Copy Worksheets(«Лист1»).Cells(i — 4, 1)

sum = sum + oRange2.Value
i = i + 1

Loop

End Sub ‘ Конец программы

[/VB]

На чем хотелось бы заострить внимание:

Объект Range.

[VB]

Set oRange2 = Worksheets(«Лист2»).Cells(i, 4)

oRange2.Select

[/VB]

Такое допустимо только если текущий лист именно второй, поэтому пришлось добавить строчку

[VB]Sheets(«Лист2»).Activate[/VB]

И, таким образом, при начале работы скрипта всегда выбирается второй лист и ошибка не возникает, ну а куда копировать-ему не сильно интересно, поэтому выбирать обратно первый лист при копировании туда не пришлось.

[VB]Selection.Copy Worksheets(«Лист1»).Cells(i — 4, 1)[/VB]

В этой строке изменен индекс, сделано просто для того, чтобы вставлялось в первую ячейку первого листа.

Файл в котором писалось приложение