Замена данных по условию - VB

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

Помогите доработать Макрос. Посмотрите Пожалуйста, может кто знает как сделать. Буду благодарен за любую помощь. Спасибо Здравствуйте! Вот такой вопрос. Есть файл Протокол в нем есть Лист Перечень, в который входят: - шифр продукции - цена - сотрудник - кто поставляет - кто изготовил - протокол Также есть лист Цены в котором также отражается эта информация, только с учетом обновленных данных Я написал макрос для замены данных из Листа Цены в Лист Перечень, по определенным критериям, а точнее вот так:

Sub Замена_цен()
 
For a1 = 2 To 65000
    If Cells(a1, 1) <> "" Then st = a1
Next a1
 
a2 = ActiveWorkbook.Name
 
Workbooks("Протокол.xls").Activate
Sheets("Цены").Select
 
For a3 = 2 To 65000
    If Cells(a3, 1) <> "" Then stt = a3
Next a3
 
For a4 = 2 To stt
    a11 = "A" & a4
    Range(a11).Select
    a5 = Cells(a4, 1)
    a6 = Cells(a4, 2)
    a10 = Cells(a4, 4)
    a13 = Cells(a4, 3)
    a14 = Cells(a4, 5)
    a15 = Cells(a4, 6)
    Workbooks(a2).Activate
    Sheets("Перечень").Select
    For a7 = 2 To st
        a12 = "A" & a7
        Range(a12).Select
        If Cells(a7, 1) = a5 Then GoTo 1
2
    Next a7
    Workbooks("Протокол.xls").Activate
    Sheets("Цены").Select
Next a4
 
Workbooks(a2).Activate
Sheets("Перечень").Select
 
MsgBox "Цены Заменены"
GoTo 3
1
Cells(a7, 3) = a6
Cells(a7, 4) = a13
Cells(a7, 5) = a10
Cells(a7, 8) = a14
Cells(a7, 7) = a15
 
GoTo 2
 
3
End Sub

В чем суть, макрос Берет информацию из Листа Цены и проверяет по столбцу 1 (шифр продукции) Лист Перечень, при совпадении (шифра продукции) происходит замена цены, сотрудника, кто поставлял,кто изготовил, протокол. Но есть существенный недостаток при количестве строк свыше 40 000 тысяч (а Перечень именно такой) цикл работы макроса по каждой позиции очень много занимает времени. Помогите как сделать, что бы - макрос работал быстрее в несколько раз(Время обработки сократить) - после замены по тем позициям которые были найдены, проставлял бы в Листе Цены в столбце “Результат обработки” информацию о том что “Продукция найдена и цены проставлены” Спасибо огромное!

Решение задачи: «Замена данных по условию»

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

                            Sub Замена_цен()
 
Dim a1 as long
Dim a2 as long
Dim a3 as long
Dim a4 as long
Dim a7 as long 
 
For a1 = 2 To 65000
If Cells(a1, 1) <> "" Then st = a1
Next a1
 
'''a2 = ActiveWorkbook.Name ???
 
Workbooks("Протокол.xls").Activate
Sheets("Цены").Select
 
For a3 = 2 To 65000
If Cells(a3, 1) <> "" Then stt = a3
Next a3
 
For a4 = 2 To stt
a11 = "A" & a4
Range(a11).Select
a5 = Cells(a4, 1)
a6 = Cells(a4, 2)
a10 = Cells(a4, 4)
a13 = Cells(a4, 3)
a14 = Cells(a4, 5)
a15 = Cells(a4, 6)
Workbooks(a2).Activate
Sheets("Перечень").Select
For a7 = 2 To st
a12 = "A" & a7
Range(a12).Select
If Cells(a7, 1) = a5 Then GoTo 1
2
Next a7
Workbooks("Протокол.xls").Activate
Sheets("Цены").Select
Next a4
 
Workbooks(a2).Activate
Sheets("Перечень").Select
 
MsgBox "Цены Заменены"
GoTo 3
1
Cells(a7, 3) = a6
Cells(a7, 4) = a13
Cells(a7, 5) = a10
Cells(a7, 8) = a14
Cells(a7, 7) = a15
 
GoTo 2
 
3
 
End Sub
                        