Копирование данных из одной книги в другую с условием

[katrin1984]

Всем привет.
Есть 2 файла.
Как перенести данные из файла "прайс-лист" (назовём его "источник") в файл "менеджеры" (назовём его "результат") при определенных условиях?
Если в файле "прайс-лист" на листе "нужный лист" I10=Подшипники, то скопировать ячейки в файл "менеджеры" на лист "ПдШ" данные следующим образом:
E10 в B2, H10 в C2, I10 в D2, K10 в E2, M10 в J2, N10 в M2.

Файл "источник" в идеале должен быть закрыт.
Запуск происходит с файла "результат".

Макрос должен просматривать не только ячейку I10, а весь столбец I.
Причем, если Вы обратили внимание, в колонке I могут быть и пустые значения, но в колонке Е не может быть пустого значения, поэтому имеет смысл использовать ячейку E при считывании диапазона.

[вложение удалено администратором]

[Администратор]

Макрос:

Sub Procedure1()
   
    ' В константах нужно указать номера строки, с которых начинаются данные (именно данные, а не шапка).
    ' Начало на листе-источнике.
    Const lngNachalo_Source As Long = 10
    ' Начало на листе-результате.
    Const lngNachalo_Res As Long = 2
   
    Dim bkSource As Excel.Workbook, shSource As Excel.Worksheet
    Dim shRes As Excel.Worksheet
    Dim lngKonec_Source As Long, lngKonec_Res As Long
    Dim i As Long
   
   
    ' Отключение обновления монитора, чтобы
        '1) не видеть открытие файла-источника;
        '2) чтобы макрос быстрее работал.
    Application.ScreenUpdating = False
   
    ' Присвоение листу-результату VBA-имени "shRes".
        ' С помощью этого имени можно будет обращаться к листу-результату в коде.
    Set shRes = Worksheets("ПдШ")
   
    ' Открытие файла-источника.
    ' Присвоение файлу-источнику VBA-имени "bkSource".
        ' С помощью этого имени можно будет обращаться к файлу-источнику в коде.
    ' ReadOnly:=True - чтобы меньше было непредсказуемых событий.
    Set bkSource = Workbooks.Open(Filename:="C:\Users\User\Desktop\прайс\Источник.xlsx", ReadOnly:=True)
   
    ' Присвоение листу-источнику VBA-имени "shSource".
        ' С помощью этого имени можно будет обращаться к листу-источнику в коде.
    Set shSource = bkSource.Worksheets("нужный_лист")
   
    ' Определение последней строки на листе-источнике.
    lngKonec_Source = shSource.UsedRange.Row + shSource.UsedRange.Rows.Count - 1
   
    ' Удаление старых данных из листа-результата.
    ' Определение последней строки на листе-результате.
        ' Дальше последняя строка будет скорректирована.
    lngKonec_Res = shRes.UsedRange.Row + shRes.UsedRange.Rows.Count - 1
    ' Удаление, если есть данные.
    If lngKonec_Res >= lngNachalo_Res Then
        shRes.Rows(lngNachalo_Res & ":" & lngKonec_Res).Delete
    End If
   
    ' Корректировка последней строки листа-результате.
        ' Переменная lngKonec_Res будет использоваться для перемещения по листу-результату.
    lngKonec_Res = lngNachalo_Res
   
   
    ' Движение по строкам на листе-листочнике.
    For i = lngNachalo_Source To lngKonec_Source Step 1
   
        ' Просмотр, что находится в нужной ячейке на листе-источнике.
        ' Если в ячейке не подшипники.
        If shSource.Cells(i, "I").Value <> "Подшипники" Then
            ' Переход к следующей строке на листе-источнике.
            GoTo metka
        End If
   
    ' Если оказались здесь, значит в ячейке слово "Подшипники".
   
    ' Функциональная часть.
    shRes.Cells(lngKonec_Res, "B").Value = shSource.Cells(i, "E").Value
    shRes.Cells(lngKonec_Res, "C").Value = shSource.Cells(i, "H").Value
    shRes.Cells(lngKonec_Res, "D").Value = shSource.Cells(i, "I").Value
    shRes.Cells(lngKonec_Res, "E").Value = shSource.Cells(i, "K").Value
    shRes.Cells(lngKonec_Res, "J").Value = shSource.Cells(i, "M").Value
    shRes.Cells(lngKonec_Res, "M").Value = shSource.Cells(i, "N").Value
   
    ' Корректировка переменной, чтобы перейти к следующей строке на листе-результате.
    lngKonec_Res = lngKonec_Res + 1
   
metka:
    Next i
   
   
    ' Закрытие файла-источника.
    bkSource.Close SaveChanges:=False
   
    ' Включение обновления монитора.
    Application.ScreenUpdating = True
   
    ' Сообщение, чтобы было понятно, что макрос сделал работу.
    MsgBox "Макрос завершил работу.", vbInformation
   
End Sub

[свернуть]