Правильно написать макрос

[Marisabell]

Помогите, пожалуйста, решиь проблему.
Прикладываю файл. В файле несколько листов.
Первый лист OSNOVA, в нём находится информация точек доставки (уникальный код человека, получающего заказ;имя-фамилия, адрес, телефон, и определённое количество каждого товара).
Второй лист—заказ—в нём указаны сроки доставки, названия товаров.
Названия, указанные в заказе, вставляются в OSNOVU. В жизне эти 2 листа заполняют разные люди.

Третий лист—обобщение первого и второго листа.
Дальше идут акты приёма товаров.

Задача—создать макрос, котрый будет вставлять в акты приёма товара количество, соответствующее определённому уникальному коду, и убирать позиции 0 (в случае если человеку этот товар не идёт). И внизу акта чтобы также удалялись названия товаров с количеством 0.
Максимальное количество проектов 25, максимальное количество точек 80!
При этом каждый раз могут меняться и товары, и количества, и уникальные коды.
Написанный мною макрос (он прикручен к листу MAKROS-EKSPIREMENT) делает всё, что необходимо, но как только меняется количество в основе, всё слетает.
ПОМОГИТЕ!!!!
Если необходимо МОГУ ОПИСАТЬ макрос.

[EducatedFool]

Попробуйте такой вариант:

Sub test()
    Application.ScreenUpdating = False    ' отключаем обновление экрана
    Dim sh As Worksheet: Set sh = ActiveSheet    ' Set sh = Sheets("MAKROS_EKSPIREMENT")
    Dim FirstCell As Range: Set FirstCell = sh.Range("G5")    ' первая ячейка
    ' берем диапазон до последней заполненной
    Dim ra As Range: Set ra = sh.Range(FirstCell, FirstCell.End(xlDown))
    ra.Value = ra.Value    ' преобразуем формулы в значения
    ra.Replace "0", vbNullString, xlWhole    ' очищаем ячейки с нулями
    On Error Resume Next
    ra.SpecialCells(xlCellTypeBlanks).EntireRow.Delete    ' удаляем строки, которые были с нулями

    sh.UsedRange.Value = sh.UsedRange.Value    ' преобразуем формулы в значения на всем листе

    ' удаляем строки с ошибками в первом столбце
    sh.Range("a:a").SpecialCells(xlCellTypeConstants, xlErrors).EntireRow.Delete
End Sub