Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
Копирование значений из отдельных ячеек из одной книги в другую
 
#1
23.10.2019 15:54:43
Добрый день друзья.

Задача передо мной тривиальная, но я не пойму логику построения её решения.
Есть две книги, условно принимаем что они открыты по умолчанию. Из книги "КП.xlsm" по нажатию кнопки "перенести данные в отчёт" скопировать ячейки (отмеченные желтым) и вставить их в таблицу книги "Отчет.xlsm" в соответствующие столбцы первой незаполненной строки.

Помогите или направьте в нужную сторону.
 
 
 
#2
23.10.2019 16:40:15
Цитата
скопировать ячейки (отмеченные желтым)
Эти ячейки всегда в одних и тех же местах, или их надо искать по Заказчик, ФИО, Адрес и т.д.
 
 
 
#3
23.10.2019 16:42:21
задаете последнюю заполненную строку файла отчет, приравниваете значение из ячеек файла КП к ячейкам последней заполненной строки файла Отчет.
Код
Sub perenos()
Dim lr As Long

lr = Workbooks("Отчет.xlsm").Sheets("CRM").Cells(Rows.Count, 2).End(xlUp).Row + 1
Workbooks("Отчет.xlsm").Sheets("CRM").Cells(lr, 2) = Workbooks("КП.xlsm").Sheets("Вывод").Cells(11, 3)
Workbooks("Отчет.xlsm").Sheets("CRM").Cells(lr, 3) = Workbooks("КП.xlsm").Sheets("Вывод").Cells(13, 3)
Workbooks("Отчет.xlsm").Sheets("CRM").Cells(lr, 4) = Workbooks("КП.xlsm").Sheets("Вывод").Cells(12, 3) & _
" " & Workbooks("КП.xlsm").Sheets("Вывод").Cells(11, 10) & " " & Workbooks("КП.xlsm").Sheets("Вывод").Cells(12, 10)
Workbooks("Отчет.xlsm").Sheets("CRM").Cells(lr, 7) = Workbooks("КП.xlsm").Sheets("Вывод").Cells(26, 14)
Workbooks("Отчет.xlsm").Sheets("CRM").Cells(lr, 8) = Workbooks("КП.xlsm").Sheets("Вывод").Cells(8, 1)
Workbooks("Отчет.xlsm").Sheets("CRM").Cells(lr, 9) = Workbooks("КП.xlsm").Sheets("Вывод").Cells(41, 14)

End Sub
 
 
 
#4
23.10.2019 16:47:14
Цитата
Kuzmich написал: Эти ячейки всегда в одних и тех же местах...
Шапка всегда одинаковая, смещаются только Сумма (смещение суммы можно отследить количеством уникальных позиций в КП, этот парметр фиксируется на другом листе) и Дата (но датой в принципе можно принебречь, её можно заменить функцией Date()).
 
 
 
#5
23.10.2019 16:57:01
Цитата
insaidd написал:
смещаются только Сумма
Цитата
insaidd написал:
и Дата
тогда так
Код
Sub perenos()
Dim lr As Long
Dim c As Variant
Dim lr1 As Long

Set c = Workbooks("КП.xlsm").Sheets("Вывод").Range("a:a").find("Итоговая сумма предложения*", LookIn:=xlValues)
b = c.Row
lr = Workbooks("Отчет.xlsm").Sheets("CRM").Cells(Rows.Count, 2).End(xlUp).Row + 1
lr1 = Workbooks("КП.xlsm").Sheets("Вывод").Cells(Rows.Count, 1).End(xlUp).Row

Workbooks("Отчет.xlsm").Sheets("CRM").Cells(lr, 2) = Workbooks("КП.xlsm").Sheets("Вывод").Cells(11, 3)
Workbooks("Отчет.xlsm").Sheets("CRM").Cells(lr, 3) = Workbooks("КП.xlsm").Sheets("Вывод").Cells(13, 3)
Workbooks("Отчет.xlsm").Sheets("CRM").Cells(lr, 4) = Workbooks("КП.xlsm").Sheets("Вывод").Cells(12, 3) & _
" " & Workbooks("КП.xlsm").Sheets("Вывод").Cells(11, 10) & " " & Workbooks("КП.xlsm").Sheets("Вывод").Cells(12, 10)
Workbooks("Отчет.xlsm").Sheets("CRM").Cells(lr, 7) = Workbooks("КП.xlsm").Sheets("Вывод").Cells(b, 14)
Workbooks("Отчет.xlsm").Sheets("CRM").Cells(lr,  = Workbooks("КП.xlsm").Sheets("Вывод").Cells(8, 1)
Workbooks("Отчет.xlsm").Sheets("CRM").Cells(lr, 9) = Workbooks("КП.xlsm").Sheets("Вывод").Cells(lr1, 14)

End Sub
 
 
 
#6
23.10.2019 16:58:22
Строку с "Итоговая сумма предложения, включая НДС 20%" можно найти при помощи функции Find
Код
FoundCell = Columns("A:M").Find("Итоговая сумма предложения, включая НДС 20%", , xlValues, xlWhole)

Дату искать в столбцах "N:O"
 
 
 
#7
23.10.2019 17:05:52
Цитата
Hellmaster написал:
тогда так
Именно так я изначально думал но спотыкнулся вот обо что. Файл Отчёт.xlsm один и его местоположение не меняется, а вот файлов КП тьма, и они разбросаны в довольно глубокой структуре папок. Поэтому тут именно нужно брать значения из КП и вставлять в статичный файл Отчет.xlsm.
 
 
 
#8
23.10.2019 17:06:39
Цитата
Kuzmich написал:
Строку с "Итоговая сумма предложения, включая НДС 20%" можно найти при помощи функции Find
Элегантно, спасибо!
 
 
 
#9
23.10.2019 17:11:12
Цитата
Hellmaster написал:
тогда так
ХОТЯ! если строго ограничить одновременым открытием нужные файлы, Workbooks("КП.xlsm") можно заменить ActiceWorkbook или ThisWorkbook
 
 
 
#10
23.10.2019 17:13:11
insaidd, тогда сделайте перебор файлов КП в папках, открывайте по очереди и делайте макрос из файла Отчет. и каждую строку с названием файла пишите как
Код
Workbooks("КП*.xlsm").Sheets("Вывод").
 
 
 
#11
23.10.2019 17:15:11
Hellmaster, уже пробую)) Спасибо.
 
 
 
#12
23.10.2019 17:21:18
Цитата
Файл Отчёт.xlsm один и его местоположение не меняется, а вот файлов КП тьма
Но ведь одновременно у вас открыты только два файла
Код
Sub Perenos()
Dim FoundCell As Range
Dim ListВывод As Worksheet
Dim ListCRM As Worksheet
Dim TotalSum As Double
Set ListВывод = ThisWorkbook.Worksheets("Вывод")
  Set ListCRM = Workbooks("Отчет.xls").Worksheets("CRM")
  Set FoundCell = Columns("A:M").Find("Итоговая сумма предложения, включая НДС 20%", , xlValues, xlWhole)
    TotalSum = FoundCell.Offset(, 1)
    'переносите эту сумму в нужную ячейку листа ListCRM
End Sub
 
 
 
#13
23.10.2019 17:33:28
Kuzmich, Конечно!!! пробую, спасибо!
 
 
 
Страницы: 1
Наверх