Имеется у меня макрос

[kzld]

Имеется у меня макрос, составленный с помощью команды этого сайта.
Теперь есть желание его улучшить
Собственно макрос и описание чего желаю

Public Sub materialykredit01()
    Dim Sht1 As Worksheet, Sht2 As Worksheet, flag As Boolean
    For Each Sht1 In Workbooks("MNT_300.07.2012_registr.xlsm").Worksheets 'это файл MNT_300.07.2012_registr.xlsm это файл получатель
        flag = False 'false если неправильно
        For Each Sht2 In Workbooks("MNT_2012_allwork.xlsm").Worksheets 'это файл MNT_2012_allwork.xlsm это файл источник
            If Sht2.Name = Sht1.Name Then 'это сооветствие имён листов в книгах
                flag = True 'true - правильно
                Exit For 'выход
            End If
            Next 'следующий
        If flag Then 'если флаг then (затем) тогда
            Sht1.Range("E17:G654").ClearContents 'очищаем предыдущие значения в файле приемнике
            For i = 3 To 500 'просматриваем файл "MNT_allwork_2012_year.xlsx" от 3 строки до 500
                If Sht2.Cells(i, 3).Value = "300.07H" And Sht2.Cells(i, 6).Value <> "" Then 'просматриваем столбец 3 файла источника и ищем строку содержащую 300.07H , просматриваем столбец 6 дата файла источника
                    For k = 17 To 664 'ищем в файле приемнике совпадение даты
                        If Sht1.Cells(k, 5).Value = 0 And Sht1.Cells(k, 1).Value = Sht2.Cells(i, 6).Value Then 'если в файле приемнике строка 17 (столбец D) значение пусто, и дата в приемнике (столбец1) совпадает  с датой файла источника  тогда
                           Sht1.Cells(k, 5).Value = Sht2.Cells(i, 12).Value 'тогда в файле приемник строка 17 (столбец D) пусто, смотрим в источник столбец 12 , копируем из источника в получатель
                           Sht1.Cells(k, 6).Value = Sht2.Cells(i, 13).Value 'далее в следующий столбец файла получателя копируем значение столбца 13 файла источника
                           Sht1.Cells(k, 7).Value = Sht2.Cells(i, 16).Value 'далее в следующий столбец файла получателя копируем значение столбца 16 файла источника
                           Sht1.Cells(k, 8).Value = Sht2.Cells(i, 17).Value 'далее в следующий столбец файла получателя копируем значение столбца 17 файла источника
                           Sht1.Cells(k, 9).Value = Sht2.Cells(i, 7).Value 'далее в столбец9 файла получателя копируем значение столбца 7 файла источника
 ' последовательно формируется строка состоящая из РНН, БИН, Номер счета, дата счета, Сумма без НДС
 ' а еще надо далее добавить сумму НДС , которая кодируется 300.07I
 ' бывает, что сумма без НДС
                Exit For
                End If
 'И ВОТ ГДЕ ТО ЗДЕСЬ ЖЕЛАЮ ПОСТАВИТЬ УСЛОВИЕ, ЕСЛИ ТРЕТИЙ СТОЛБЕЦ ФАЙЛА ИСТОЧНИКА РАВЕН 300.07I, ЗАПОЛНИТЬ СТОЛБЕЦ 10 ФАЙЛА ПОЛУЧАТЕЛЯ ЗНАЧЕНИЕМ СТОЛБЦА7 (сумма) файла источника
                    Next k
                End If
            Next i
        End If
    Next
End Sub

Не смог найти теги для правильно оформления тела макроса, для публикации здесь.

[Скрипт]

kzld, у вас 4 файла, какой файл смотреть?

Два файла имеют редкие расширения, которые с языком "VBA" не связаны:
makros - без расширения;
Descript.ion

Что это за файлы и зачем вы их выложили?

[Hugo121]

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

[Hugo121]

Хотя вот, не особо вникая в алгоритм (имхо там есть непонятные моменты, но может так и нужно, и ещё очистку подправил):

Public Sub materialykredit01()
    Dim Sht1 As Worksheet, Sht2 As Worksheet, flag As Boolean
    For Each Sht1 In Workbooks("MNT_300.07.2012_registr.xlsm").Worksheets    'это файл MNT_300.07.2012_registr.xlsm это файл получатель
        flag = False    'false если неправильно
        For Each Sht2 In Workbooks("MNT_2012_allwork.xlsm").Worksheets    'это файл MNT_2012_allwork.xlsm это файл источник
            If Sht2.Name = Sht1.Name Then    'это сооветствие имён листов в книгах
                flag = True    'true - правильно
                Exit For    'выход
            End If
        Next    'следующий
        If flag Then    'если флаг then (затем) тогда
            Sht1.Range("E17:J654").ClearContents    'очищаем предыдущие значения в файле приемнике
            For i = 3 To 500    'просматриваем файл "MNT_allwork_2012_year.xlsx" от 3 строки до 500
                Select Case True
                Case Sht2.Cells(i, 3).Value = "300.07H" And Sht2.Cells(i, 6).Value <> ""    ' Then    'просматриваем столбец 3 "MNT_allwork_2012_year.xlsx" ищем 300.07H, просматриваем столбец 6 дата
                    For k = 17 To 664    'ищем в файле приемнике совпадение даты
                        If Sht1.Cells(k, 5).Value = 0 And Sht1.Cells(k, 1).Value = Sht2.Cells(i, 6).Value Then    'если в файле приемнике РНН пусто, смотрим файл приемник столбец 1 дата, если совпадает тогда
                            Sht1.Cells(k, 5).Value = Sht2.Cells(i, 12).Value    'если в файле приемнике РНН пусто, смотрим в работу столбец 14 РНН, копируем из работы в кассу
                            Sht1.Cells(k, 6).Value = Sht2.Cells(i, 13).Value    'если в файле приемнике РНН пусто, смотрим в файл источник столбец 14 РНН, копируем из источника в получатель
                            Sht1.Cells(k, 7).Value = Sht2.Cells(i, 16).Value
                            Sht1.Cells(k, 8).Value = Sht2.Cells(i, 17).Value
                            Sht1.Cells(k, 9).Value = Sht2.Cells(i, 7).Value
                            Exit For
                        End If
                    Next k
                Case Sht2.Cells(i, 3).Value = "300.07I" And Sht2.Cells(i, 6).Value <> ""
                    For k = 17 To 664    'ищем в файле приемнике совпадение даты
                        If Sht1.Cells(k, 10).Value = 0 And Sht1.Cells(k, 1).Value = Sht2.Cells(i, 6).Value Then    'если в файле приемнике РНН пусто, смотрим файл приемник столбец 1 дата, если совпадает тогда
                            Sht1.Cells(k, 10).Value = Sht2.Cells(i, 7).Value
                            Exit For
                        End If
                    Next k

                End Select
            Next i
        End If
    Next
End Sub

[kzld]

Сообщение от Hugo121

Хотя вот, не особо вникая в алгоритм (имхо там есть непонятные моменты, но может так и нужно, и ещё очистку подправил):

Спасибо. То что желал получить

[kzld]

Сообщение от Hugo121

Хотя вот, не особо вникая в алгоритм (имхо там есть непонятные моменты, но может так и нужно, и ещё очистку подправил):

На основе данного макроса , понасоздавал себе кучу файлов и теперь оперативно "вытаскиваю" нужные мне данные, как то доход,затраты,зарплата начисленная и выданная, сумма НДС к начислению и к зачету.

Но этот макрос работает из файла приемника.
Как и что подправить,что бы макрос работал из третьего файла.
Естественно ,оба файла предварительно открою

[Hugo121]

Бегло глянул - вроде без переделок должен работать и из третьего файла. Попробуйте.

[kzld]

Сообщение от Hugo121

Бегло глянул - вроде без переделок должен работать и из третьего файла. Попробуйте.

Первый макрос ЗАПОЛНИТЬ ЛИСТЫ 01-12 работает
А вот второй ЗАПОЛНИТЬ ЛИСТ СВОДНЫЙ ругается на следующую строчку, выделена подчеркиванием

Private Declare Function GetTickCount Lib "kernel32" () As Long
Sub Find_()
Dim arr1, arr2, arr3, n As Long, i As Long, sh As Worksheet, t
If MsgBox("Произвести поиск данных?", 32 & vbYesNo, "ПОИСК") = vbNo Then Exit Sub
Application.ScreenUpdating = False
t = GetTickCount
Range("D17:T7791").ClearContents
Range("AA17:AA7791").ClearContents
arr1 = Range("D17:T7791").Value
arr3 = Range("AA17:AC7791").Value
For Each sh In ThisWorkbook.Worksheets
    If sh.Name <> ActiveSheet.Name Then
        arr2 = sh.Range("E17:U664").Value
        For i = 1 To UBound(arr2)
            If arr2(i, 1) > 0 Then
                n = n + 1: arr1(n, 1) = arr2(i, 1): arr1(n, 2) = arr2(i, 2): arr1(n, 3) = arr2(i, 3): arr1(n, 4) = arr2(i, 4): arr1(n, 5) = arr2(i, 5): arr1(n, 6) = arr2(i, 6): arr3(n, 1) = "Лист " & sh.Name & "|" & " номер " & i
            End If
        Next i
    End If
Next sh
[D17].Resize(n, 9).Value = arr1
[AA17].Resize(n, 1).Value = arr3
MsgBox "Затрачено времени на поиск данных: " & (GetTickCount - t) / 1000, vbInformation, "ГОТОВО"
Application.ScreenUpdating = True
End Sub

Собственно, для чего нужна эта строчка.Временами она меня "достает"

[Hugo121]

Тут в этом макросе у каждого диапазона нужно указать, чей он - сейчас это будет активный лист, а Вам нужно привязать их к тем листам/книгам, которы обрабатываются (как в первом макросе).
Ну и ThisWorkbook тоже не годится - это будет книга с макросом.
Добавьте пару переменных as object, задайте им (через set) ссылки на нужные книги или листы (похоже что одну на лист сводный, вторую на книгу, откуда тянете данные).
Ну и у каждого диапазона пропишите, чей он.