Есть 2 книги в Excel, В Книги 1 есть Таблица, содержащая 2 столбца "КодКонтрагента" и "Артикул", в Книге 2 содержится ячейка ("В4") с указанным значением (КодКонтрагента) и Таблица, по этому указанному коду в ячейки ("В4") нужно провести поиск в Книге 1, в столбце "КодКонтрагента". Нужно скопировать совпадающие значения из столбца "Артикул" в Таблицу Книги 2 (Ячейка("В4") = все совпадающие коды в КодеКонтрагента).
Пока у меня есть макрос, который переносит все артикулы из Книги 1 в Книгу 2, не учитывая значения ячейки из Книги2 КодКонтрагента.
Пока у меня есть макрос, который переносит все артикулы из Книги 1 в Книгу 2, не учитывая значения ячейки из Книги2 КодКонтрагента.
| Код |
|---|
Sub Загрузка_данных()
Dim wbData As Workbook, sPath As String
If MsgBox("Загрузить данные на лист?", vbQuestion + vbYesNo, "Загрузка данных") = vbNo Then Exit Sub
'очищаем данные на листе
With Worksheets("ОТЧЕТ").Range("B13:B100000").ClearContents
End With
'запрашиваем путь к файлу
sPath = Application.GetOpenFilename("Файлы Excel (*.xls*),*.xls*", 1, "Выберите файл с данными", , False)
If sPath = "False" Then Exit Sub
'отключаем обновление экрана
Application.ScreenUpdating = False
'открываем файл с данными
Set wbData = Workbooks.Open(sPath, UpdateLinks:=False, ReadOnly:=True)
'копируем столбцы и убираем дубли
wbData.Worksheets("Продажи").Range("D1:D220625").RemoveDuplicates 4
wbData.Worksheets("Продажи").Range("D2:D220625").Copy ThisWorkbook.Worksheets("ОТЧЕТ").Range("B13")
'закрываем файл с данными
wbData.Close SaveChanges:=False
'включаем обновление экрана
Application.ScreenUpdating = True
MsgBox "Данные на лист загружены!", vbInformation, "Загрузка данных"
End Sub |
