Добрый день многоуважаемые форумчане. Прошу Вас помощи в решении. ЧЕСТНО! Пытался сам, пытал ГУГЛ помощи, смотрел в книгу "видел фигу " и все это в течении двух суток. Информации очень много с решением, но увы не смог достичь что нужно мне. Имеется таблица "Отгрузка" на листе1, условие такое Нужно чтоб при любом изменении в данной таблице эти данные "дублировались, копировались" на лист2 в таблицу (пусть будет "Отчет") но не вся полностью а лишь три ДАТА, НОМЕР СЧЕТ. Прекрасно понимаю что для каких либо изменений в таблице я должен применить вот этот код
[vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range) If Not Intersect(Target, Range("Отгрузка[#All]")) Is Nothing Then Application.EnableEvents = 0 "тут сам код для "дублирования, копирования" или же макрос с этим действием Application.EnableEvents = 1 End If End Sub
[/vba]
Но тут я потерялся совсем Объявление переменных, поиск последней строки, выделение, копирование на другой лист в нужный мне диапазон Наткнулся на код который копирует но всю таблицу переносит на нужный лист но не как таблицу а лишь значения Прошу Вас подскажите как более правильно преобразовать код в нужное мне русло, спасибо за ранее за ответы Сам код вот [vba]
Код
Sub iCopy() Dim Sht As Worksheet Dim iLastRow As Long iLastRow = Cells(Rows.Count, 1).End(xlUp).Row For Each Sht In Worksheets If Sht.Name <> "Лист1" Then If Sht.Name = "Лист2" Then With Sht Range("A3:D" & iLastRow).Copy .Cells(3, 1).PasteSpecial xlPasteColumnWidths .Cells(3, 1).PasteSpecial xlPasteValues End With End If End If Next End Sub
[/vba] Пытался записать свое действие и применить это все для листа3 при этом на листе1 применить Worksheet_Change тогда код ругается [vba]
Код
Sub Макрос2() ' Макрос2 Макрос Range("A2:A8,C2:D8").Select Range("Отгрузка[[#Headers],[номер]]").Activate Application.CutCopyMode = False Selection.Copy Sheets("Лист3").Select Range("A2").Select ActiveSheet.Paste Application.CutCopyMode = False ActiveSheet.ListObjects.Add(xlSrcRange, Range("$A$2:$C$8"), , xlYes).Name = _ "Таблица2" Range("Таблица2[#All]").Select End Sub
[/vba]
ааааааа
Добрый день многоуважаемые форумчане. Прошу Вас помощи в решении. ЧЕСТНО! Пытался сам, пытал ГУГЛ помощи, смотрел в книгу "видел фигу " и все это в течении двух суток. Информации очень много с решением, но увы не смог достичь что нужно мне. Имеется таблица "Отгрузка" на листе1, условие такое Нужно чтоб при любом изменении в данной таблице эти данные "дублировались, копировались" на лист2 в таблицу (пусть будет "Отчет") но не вся полностью а лишь три ДАТА, НОМЕР СЧЕТ. Прекрасно понимаю что для каких либо изменений в таблице я должен применить вот этот код
[vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range) If Not Intersect(Target, Range("Отгрузка[#All]")) Is Nothing Then Application.EnableEvents = 0 "тут сам код для "дублирования, копирования" или же макрос с этим действием Application.EnableEvents = 1 End If End Sub
[/vba]
Но тут я потерялся совсем Объявление переменных, поиск последней строки, выделение, копирование на другой лист в нужный мне диапазон Наткнулся на код который копирует но всю таблицу переносит на нужный лист но не как таблицу а лишь значения Прошу Вас подскажите как более правильно преобразовать код в нужное мне русло, спасибо за ранее за ответы Сам код вот [vba]
Код
Sub iCopy() Dim Sht As Worksheet Dim iLastRow As Long iLastRow = Cells(Rows.Count, 1).End(xlUp).Row For Each Sht In Worksheets If Sht.Name <> "Лист1" Then If Sht.Name = "Лист2" Then With Sht Range("A3:D" & iLastRow).Copy .Cells(3, 1).PasteSpecial xlPasteColumnWidths .Cells(3, 1).PasteSpecial xlPasteValues End With End If End If Next End Sub
[/vba] Пытался записать свое действие и применить это все для листа3 при этом на листе1 применить Worksheet_Change тогда код ругается [vba]
Код
Sub Макрос2() ' Макрос2 Макрос Range("A2:A8,C2:D8").Select Range("Отгрузка[[#Headers],[номер]]").Activate Application.CutCopyMode = False Selection.Copy Sheets("Лист3").Select Range("A2").Select ActiveSheet.Paste Application.CutCopyMode = False ActiveSheet.ListObjects.Add(xlSrcRange, Range("$A$2:$C$8"), , xlYes).Name = _ "Таблица2" Range("Таблица2[#All]").Select End Sub
Здравствуйте, lebensvoll, вам надо что бы скопировались изменения, т.е. было-стало? или просто колонки целиком? Если целиком, то можно добавить таблицу которая будет ссылаться на таблицу "Отгрузка" и обновлять ее по удобному событию: то ли внесение изменений, то ли активация/деактивация листа
В примере добавил таблицу и события. Не нужное закомментируйте. ну или [vba]
Здравствуйте, lebensvoll, вам надо что бы скопировались изменения, т.е. было-стало? или просто колонки целиком? Если целиком, то можно добавить таблицу которая будет ссылаться на таблицу "Отгрузка" и обновлять ее по удобному событию: то ли внесение изменений, то ли активация/деактивация листа
В примере добавил таблицу и события. Не нужное закомментируйте. ну или [vba]
boa, спасибо за отзывчивость... Но файл не смог открыть [img][/img]
Цитата
вам надо что бы скопировались изменения, т.е. было-стало?
Нужно чтоб при любых изменениях в таблице на листе 1 (данные "копировались, дублировались" Не вся таблица а лишь 1;3;4 графы) на другой лист2 в таблицу
boa, спасибо за отзывчивость... Но файл не смог открыть [img][/img]
Цитата
вам надо что бы скопировались изменения, т.е. было-стало?
Нужно чтоб при любых изменениях в таблице на листе 1 (данные "копировались, дублировались" Не вся таблица а лишь 1;3;4 графы) на другой лист2 в таблицуlebensvoll
Private Sub Worksheet_Change(ByVal Target As Range) If Not Intersect(Target, Range("Отгрузка[#All]")) Is Nothing Then Application.EnableEvents = 0 Range("A2:A8,C2:C8,D2:D8").Copy Sheets("Лист3").Cells(2, 1) Application.EnableEvents = 1 End If End Sub
[/vba]
или используйте копирование [vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range) If Not Intersect(Target, Range("Отгрузка[#All]")) Is Nothing Then Application.EnableEvents = 0 Range("A2:A8,C2:C8,D2:D8").Copy Sheets("Лист3").Cells(2, 1) Application.EnableEvents = 1 End If End Sub
boa, Спасибо огромное!!! Блин это все можно было лишь в одну строку прописать Но буду все равно искать и пробывать как сделать так (вот оператор дополнил таблицу новыми данными "увеличил диапазон" примерно) тогда код уже не приемлем Спасибо еще раз
boa, Спасибо огромное!!! Блин это все можно было лишь в одну строку прописать Но буду все равно искать и пробывать как сделать так (вот оператор дополнил таблицу новыми данными "увеличил диапазон" примерно) тогда код уже не приемлем Спасибо еще разlebensvoll
это фигня. А вот если уменьшил кол-во строк, вот здесь засада Я бы вот так написал. Пробегается по второй таблице, берет названия столбцов, ищет их в первой таблице и копирует найденный столбец Обработчик ошибки в случае ненахождения искомого столбца самостоятельно добавьте там, я забыл Добавил. Файл перевложил [vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range) If Not Intersect(Target, Range("Отгрузка")) Is Nothing Then Set tb1_ = Sheets("Лист3").ListObjects("Таблица2") With tb1_ nc_ = .ListColumns.Count nr_ = .ListRows.Count If nr_ Then .Range(1).Offset(1).Resize(nr_, nc_).Delete End If On Error Resume Next For i = 1 To nc_ Range("Отгрузка[" & .Range(i) & "]").Copy .Range(nc_ + i) Next i On Error GoTo 0 End With End If End Sub
это фигня. А вот если уменьшил кол-во строк, вот здесь засада Я бы вот так написал. Пробегается по второй таблице, берет названия столбцов, ищет их в первой таблице и копирует найденный столбец Обработчик ошибки в случае ненахождения искомого столбца самостоятельно добавьте там, я забыл Добавил. Файл перевложил [vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range) If Not Intersect(Target, Range("Отгрузка")) Is Nothing Then Set tb1_ = Sheets("Лист3").ListObjects("Таблица2") With tb1_ nc_ = .ListColumns.Count nr_ = .ListRows.Count If nr_ Then .Range(1).Offset(1).Resize(nr_, nc_).Delete End If On Error Resume Next For i = 1 To nc_ Range("Отгрузка[" & .Range(i) & "]").Copy .Range(nc_ + i) Next i On Error GoTo 0 End With End If End Sub
_Boroda_, Ваш пример более выразителен и убийственен в решении задачи... Но увы... Данный пример хотел применить для файла другого (Другие листы скрыты) имеется два листа (Отгрузка и Отчет списание). Задача моя была в следующем (ну как думал Я, в итоге подход был задуман не верен) Оператор вносит отгрузку в таблицу Отгрузка на листе Отгрузка по кнопке. Как только данная запись была внесена, то она сразу дублируется (куском, не все таблица а нужное) на другой лист. Ваш код Александр гениален но почему то для моего примера он не подошел. Но хотя не могу понять почему. Ведь даже на Вашем примере если бы я добавил новую хоть какую то запись то она дополняется сразу на другой лист. А скопировал его в файл (((( потерпел крах Он работает если я после внесении новой записи изменяю что то либо в таблице тогда она сразу на ура работает.
_Boroda_, Ваш пример более выразителен и убийственен в решении задачи... Но увы... Данный пример хотел применить для файла другого (Другие листы скрыты) имеется два листа (Отгрузка и Отчет списание). Задача моя была в следующем (ну как думал Я, в итоге подход был задуман не верен) Оператор вносит отгрузку в таблицу Отгрузка на листе Отгрузка по кнопке. Как только данная запись была внесена, то она сразу дублируется (куском, не все таблица а нужное) на другой лист. Ваш код Александр гениален но почему то для моего примера он не подошел. Но хотя не могу понять почему. Ведь даже на Вашем примере если бы я добавил новую хоть какую то запись то она дополняется сразу на другой лист. А скопировал его в файл (((( потерпел крах Он работает если я после внесении новой записи изменяю что то либо в таблице тогда она сразу на ура работает.lebensvoll
lebensvoll, если оператор увеличивает количество строк(что есть нормально), то используйте копирование из сообщения №6 определив последнюю строку можно переписать Range [vba]
[/vba] ну а если он столбцы будет добавлять/двигать, то можно финдом по заголовку таблицы пройтись и определить копируемый диапазон. [vba]
Код
Sub NewMacros() Dim LastRow&, LetterCol$, AddressRange$, a With Sheets("Лист1") LastRow = .UsedRange.SpecialCells(xlLastCell).Row 'получаем номер последней строки For Each a In Array("дата", "номер", "счет") LetterCol = Split(.Columns(.Range("Отгрузка[[#Headers]]").Find(a, LookIn:=xlValues, LookAt:=xlWhole).Column).Address(0, 0), ":")(0) 'получаем букву столбца AddressRange = AddressRange & IIf(Len(AddressRange) > 0, ",", "") & LetterCol & "2:" & LetterCol & LastRow 'генерируем строку адреса Next .Range(AddressRange).Copy Sheets("Лист3").Cells(2, 1) End With End Sub
[/vba]
lebensvoll, если оператор увеличивает количество строк(что есть нормально), то используйте копирование из сообщения №6 определив последнюю строку можно переписать Range [vba]
[/vba] ну а если он столбцы будет добавлять/двигать, то можно финдом по заголовку таблицы пройтись и определить копируемый диапазон. [vba]
Код
Sub NewMacros() Dim LastRow&, LetterCol$, AddressRange$, a With Sheets("Лист1") LastRow = .UsedRange.SpecialCells(xlLastCell).Row 'получаем номер последней строки For Each a In Array("дата", "номер", "счет") LetterCol = Split(.Columns(.Range("Отгрузка[[#Headers]]").Find(a, LookIn:=xlValues, LookAt:=xlWhole).Column).Address(0, 0), ":")(0) 'получаем букву столбца AddressRange = AddressRange & IIf(Len(AddressRange) > 0, ",", "") & LetterCol & "2:" & LetterCol & LastRow 'генерируем строку адреса Next .Range(AddressRange).Copy Sheets("Лист3").Cells(2, 1) End With End Sub
а что бы отрабатывало и для новых строк таблицы в модульлиста вставьте [vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range) Dim iCol&, a With Me For Each a In Array("дата", "номер", "счет") iCol = .Range("Отгрузка[[#Headers]]").Find(a, LookIn:=xlValues, LookAt:=xlWhole).Column If Target.Column = iCol Then Call NewMacros: Exit Sub Next End With End Sub
[/vba]
а что бы отрабатывало и для новых строк таблицы в модульлиста вставьте [vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range) Dim iCol&, a With Me For Each a In Array("дата", "номер", "счет") iCol = .Range("Отгрузка[[#Headers]]").Find(a, LookIn:=xlValues, LookAt:=xlWhole).Column If Target.Column = iCol Then Call NewMacros: Exit Sub Next End With End Sub
А все потому, что кто-то до сих пор не выучил п.3 Правил форума и кладет примеры, несоответствующие реальным файлам [vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range) If Not Intersect(Target, Range("Отгрузка")) Is Nothing Then Set tb1_ = Sheets("Отчет списание").ListObjects("Отчет") With tb1_ nc_ = .ListColumns.Count ' nr_ = .ListRows.Count ' If nr_ Then ' .Range(1).Offset(1).Resize(nr_, nc_).Delete ' End If On Error Resume Next For i = 1 To nc_ Range("Отгрузка[" & .Range(i) & "]").Copy .Range(nc_ + i) Next i On Error GoTo 0 End With End If End Sub
[/vba]
А все потому, что кто-то до сих пор не выучил п.3 Правил форума и кладет примеры, несоответствующие реальным файлам [vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range) If Not Intersect(Target, Range("Отгрузка")) Is Nothing Then Set tb1_ = Sheets("Отчет списание").ListObjects("Отчет") With tb1_ nc_ = .ListColumns.Count ' nr_ = .ListRows.Count ' If nr_ Then ' .Range(1).Offset(1).Resize(nr_, nc_).Delete ' End If On Error Resume Next For i = 1 To nc_ Range("Отгрузка[" & .Range(i) & "]").Copy .Range(nc_ + i) Next i On Error GoTo 0 End With End If End Sub
_Boroda_, спорить не буду. Простите если что не так... Но задача ведь была аналогична задумке на другом листе. Но понимание того что ошибочно пришло с ответом. Потому как в теме поста был файл с данными которые просто либо заполняются или дополняются. А куда это решение хотел применить дополнение через кнопку Но я то думал что и там и там умные таблицы и итог решения одинаков Закоментирование части кода не дало решения. Запись вносится а на другой лист она дублируется лишь тогда когда начинаешь корректировать записи в таблице. [vba]
Код
' nr_ = .ListRows.Count ' If nr_ Then ' .Range(1).Offset(1).Resize(nr_, nc_).Delete ' End If
[/vba] Мое мнение возможно ли что нужно как то прописать определение последней ячейки в таблице. Но не уверен в логике [vba]
Код
lLastRow = Cells(Rows.Count,1).End(xlUp).Row
[/vba] Скорее всего можно поступить иначе и привязаться к кнопке "Внесения записи" но тогда теряется "задача". Потому как оператор может потом взять и удалить запись из таблицы в одной таблицы запись будет а в другой не будет. Или еще хуже в одной она будет с одними данными (а потом оператор меняет что нибудь, есть такое за ними) а у меня будут записаны другие данные....
_Boroda_, спорить не буду. Простите если что не так... Но задача ведь была аналогична задумке на другом листе. Но понимание того что ошибочно пришло с ответом. Потому как в теме поста был файл с данными которые просто либо заполняются или дополняются. А куда это решение хотел применить дополнение через кнопку Но я то думал что и там и там умные таблицы и итог решения одинаков Закоментирование части кода не дало решения. Запись вносится а на другой лист она дублируется лишь тогда когда начинаешь корректировать записи в таблице. [vba]
Код
' nr_ = .ListRows.Count ' If nr_ Then ' .Range(1).Offset(1).Resize(nr_, nc_).Delete ' End If
[/vba] Мое мнение возможно ли что нужно как то прописать определение последней ячейки в таблице. Но не уверен в логике [vba]
Код
lLastRow = Cells(Rows.Count,1).End(xlUp).Row
[/vba] Скорее всего можно поступить иначе и привязаться к кнопке "Внесения записи" но тогда теряется "задача". Потому как оператор может потом взять и удалить запись из таблицы в одной таблицы запись будет а в другой не будет. Или еще хуже в одной она будет с одними данными (а потом оператор меняет что нибудь, есть такое за ними) а у меня будут записаны другие данные....lebensvoll
Кто бы ты ни был, мир в твоих руках
Сообщение отредактировал lebensvoll - Среда, 05.12.2018, 16:52
_Boroda_, Ну вот смотрите на листе ОТГРУЗКА оператором вносится запись, которую он формирует тут [img][/img] Затем вносит эти данные в таблицу на лист Отгрузка при нажатии кнопки [img][/img] Данные вносятся в таблицу [img][/img] И как только эти данные внеслись в таблицу то они дублируются на лист Отчет списание Но лишь часть нужных столбцов из таблицы Отгрузка (Дата; Контрагент; Госномер ТС; Продукция; Количество) [img][/img] Но есть нюанс. Любые изменения в таблице Отгрузка, должны сразу же дублироваться (конечно же интересует лишь столбцы Дата; Контрагент; Госномер ТС; Продукция; Количество) в другой таблице Отчет. Ваше решение было отличным и оно срабытавает. Но лишь только тогда когда оператор производит изменения в таблице Отгрузка. А вот когда появляется новая запись увы (хотя в файле первого файла сообщения №8 она срабатывает на ура просто. К примеру я беру и протягиваю таблицу дальше на две три строки и забиваю туда информация и как только я ее завершаю они дублируются). ПОЧЕМУ ТАК ТО
_Boroda_, Ну вот смотрите на листе ОТГРУЗКА оператором вносится запись, которую он формирует тут [img][/img] Затем вносит эти данные в таблицу на лист Отгрузка при нажатии кнопки [img][/img] Данные вносятся в таблицу [img][/img] И как только эти данные внеслись в таблицу то они дублируются на лист Отчет списание Но лишь часть нужных столбцов из таблицы Отгрузка (Дата; Контрагент; Госномер ТС; Продукция; Количество) [img][/img] Но есть нюанс. Любые изменения в таблице Отгрузка, должны сразу же дублироваться (конечно же интересует лишь столбцы Дата; Контрагент; Госномер ТС; Продукция; Количество) в другой таблице Отчет. Ваше решение было отличным и оно срабытавает. Но лишь только тогда когда оператор производит изменения в таблице Отгрузка. А вот когда появляется новая запись увы (хотя в файле первого файла сообщения №8 она срабатывает на ура просто. К примеру я беру и протягиваю таблицу дальше на две три строки и забиваю туда информация и как только я ее завершаю они дублируются). ПОЧЕМУ ТАК ТОlebensvoll
Кто бы ты ни был, мир в твоих руках
Сообщение отредактировал lebensvoll - Среда, 05.12.2018, 17:07
Вход
Регистрация
Напомнить пароль
Автосумма
Часто используемые
ВПР
ЕСЛИ
СУММЕСЛИ
Финансовые
Логические
Текстовые
Даты и времени 
Ссылки и массивы 
Математические
Другие функции
Проверка свойств и значений
Баз данных
Математические
Обработки массивов
Обработки строк
Преобразования типов данных 
Загрузки данных
Работы с файлами
Обработки системных параметров
Обработки цвета
Работы с датами и временем
Преобразования в системы счисления
Финансовые
" и все это в течении двух суток.
СПАСИБО ВАМ ОГРОМНОЕ АЛЕКСАНДР!!!
