День добрый! Помогите люди добрые. Имеется два стобца, в одном имя (допустим столбец A), в другом дата (допустим B), заполняются по мере поступления информации. Что нужно: Если в ячейке (в столбце "B") заполняется дата, то ячейка из "A", в которую заполняется имя и плюс данные из столбца "C" (допустим сумма) - копируется в другую книгу. Соответственно по мере заполнения первой книги - эти три ячейки копируются в другую книгу на последнюю не заполненную строчку. Другая книга лежит в той же папке. Как пример прикреплю файл. Если это дело происходит в одной книге, то все просто, а вот как в другую книгу это копировать - незнаю
День добрый! Помогите люди добрые. Имеется два стобца, в одном имя (допустим столбец A), в другом дата (допустим B), заполняются по мере поступления информации. Что нужно: Если в ячейке (в столбце "B") заполняется дата, то ячейка из "A", в которую заполняется имя и плюс данные из столбца "C" (допустим сумма) - копируется в другую книгу. Соответственно по мере заполнения первой книги - эти три ячейки копируются в другую книгу на последнюю не заполненную строчку. Другая книга лежит в той же папке. Как пример прикреплю файл. Если это дело происходит в одной книге, то все просто, а вот как в другую книгу это копировать - незнаю Hu40Cu
Private Sub Worksheet_Change(ByVal Target As Range) If Not Intersect(Target, Columns(2)) Is Nothing Then Dim iLR As Long Dim iBook As Workbook Application.EnableEvents = False Set iBook = Workbooks("Другая книга.xls") With iBook.Worksheets("Лист1") iLR = .Cells(Rows.Count, 1).End(xlUp).Row + 1 Target.Offset(, -1).Resize(, 3).Copy .Cells(iLR, 1) End With End If Application.EnableEvents = True End Sub
[/vba] Обе книги должны быть открыты!
Цитата
а вот как в другую книгу это копировать
Макрос в Лист1 первой книги [vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range) If Not Intersect(Target, Columns(2)) Is Nothing Then Dim iLR As Long Dim iBook As Workbook Application.EnableEvents = False Set iBook = Workbooks("Другая книга.xls") With iBook.Worksheets("Лист1") iLR = .Cells(Rows.Count, 1).End(xlUp).Row + 1 Target.Offset(, -1).Resize(, 3).Copy .Cells(iLR, 1) End With End If Application.EnableEvents = True End Sub
Вариант с ODBC подключением таблица автоматически обновляется при изменении ячейки М2, или ПКМ по таблице>Обновить Имя файла, из которого копируются данные вписано в диспетчере имен в файле "другая книга.xlsm" текст запроса [vba]
Код
select distinct * from (SELECT * from `Лист1$` in 'D:\папка\другая книга.xlsm' 'Excel 12.0 xml;hdr=no;' union all select * from`Лист1$` in 'D:\папка\2963331.xlsx' 'Excel 12.0 xml;hdr=no;' where F2 is not null)
[/vba] плюс макрос для обновления текста запроса в модуле Лист [vba]
Код
Public WithEvents QT As QueryTable Private Sub qt_BeforeRefresh(Cancel As Boolean) QT.CommandText = "select distinct * from (SELECT * from `Лист1$` in '" & _ ThisWorkbook.FullName & "' 'Excel 12.0 xml;hdr=no;' union all select" & _ " * from`Лист1$` in '" & ThisWorkbook.Path & "\" & [ИмяФайла] & "' " & _ "'Excel 12.0 xml;hdr=no;' where F2 is not null)" End Sub
[/vba] в ЭтаКнига[vba]
Код
Private Sub Workbook_Open() Set Лист1.QT = ThisWorkbook.Connections("запрос").Ranges(1).ListObject.QueryTable End Sub
[/vba]
Вариант с ODBC подключением таблица автоматически обновляется при изменении ячейки М2, или ПКМ по таблице>Обновить Имя файла, из которого копируются данные вписано в диспетчере имен в файле "другая книга.xlsm" текст запроса [vba]
Код
select distinct * from (SELECT * from `Лист1$` in 'D:\папка\другая книга.xlsm' 'Excel 12.0 xml;hdr=no;' union all select * from`Лист1$` in 'D:\папка\2963331.xlsx' 'Excel 12.0 xml;hdr=no;' where F2 is not null)
[/vba] плюс макрос для обновления текста запроса в модуле Лист [vba]
Код
Public WithEvents QT As QueryTable Private Sub qt_BeforeRefresh(Cancel As Boolean) QT.CommandText = "select distinct * from (SELECT * from `Лист1$` in '" & _ ThisWorkbook.FullName & "' 'Excel 12.0 xml;hdr=no;' union all select" & _ " * from`Лист1$` in '" & ThisWorkbook.Path & "\" & [ИмяФайла] & "' " & _ "'Excel 12.0 xml;hdr=no;' where F2 is not null)" End Sub
[/vba] в ЭтаКнига[vba]
Код
Private Sub Workbook_Open() Set Лист1.QT = ThisWorkbook.Connections("запрос").Ranges(1).ListObject.QueryTable End Sub
Добрый день! Тоже столкнулась с аналогичным запросом. Но особенность в том, что из имеющихся данных в исходном файле нужно переносить только те, которые отвечают критерию - в данном случае страна (Россия, Украина). Помогите, пожалуйста, расширить уже предложенные варианты подобным запросом!
Добрый день! Тоже столкнулась с аналогичным запросом. Но особенность в том, что из имеющихся данных в исходном файле нужно переносить только те, которые отвечают критерию - в данном случае страна (Россия, Украина). Помогите, пожалуйста, расширить уже предложенные варианты подобным запросом!Monoblein
Вход
Регистрация
Напомнить пароль
Автосумма
Часто используемые
ВПР
ЕСЛИ
СУММЕСЛИ
Финансовые
Логические
Текстовые
Даты и времени 
Ссылки и массивы 
Математические
Другие функции
Проверка свойств и значений
Баз данных
Математические
Обработки массивов
Обработки строк
Преобразования типов данных 
Загрузки данных
Работы с файлами
Обработки системных параметров
Обработки цвета
Работы с датами и временем
Преобразования в системы счисления
Финансовые
