Добрый день. Помогите, пожалуйста, написать макрос.
Задача: Если на листе "Зибель" в умной таблице "Таблица13" появляется новая строка (путем стандартного добавления или путем записи в строку снизу новых данных), то необходимо копировать значения конкретных ячеек (после ввода значения в ячейку, находящейся в этой новой добавленной строке) на лист "Лист1" в умную таблицу "Таблица1", предварительно добавив новую строку внизу таблицы.
Ожидаемый результат: в умной таблице на Листе1 добавилась снизу новая строка, значения подставились в эту строку по маппингу, а в ячейку D6 подставилась константа "Зибель".
Нашел вариант на событие на сайте. Вроде работает, только комментарии в первую очередь надо заполнять Еще событие не срабатывает, если в Таблица13 удалить строки
Михаил Л, спасибо большое. потестил немного, т.е. макрос работает по кнопке? Если так, то не вижу необходимости в формуле "Просмотр" и в самом первом макросе, который сравнивает I1 и J1. Если макрос1 запускать, то он будет все время копировать последнюю строку.
Если мы идем с вариантом по кнопке, то можно доработать так, чтобы копирование было не последней строки, а выделенной? Ведь в таблицу строку можно добавить не только внизу, но и в середину (через стандартное добавление).
bagdasarov86, по какому событию вам нужно копировать строку?? - можно сделать отдельную ячейку сбоку после заполнения вы туда вносите что хотите и тогда сразу переносится строка....
bagdasarov86, посмотрите второй файл. насчет доработок - если даже и захочу доработать - не смогу-не умею. Но думаю помогут исправить, только просьбу о переносе на другой форум уберите, а то я не узнаю конечный текст макроса)
Да, интересный вариант. Но если в таблицу 13 добавлять строки в середину, это будет приводить к постоянному копированию последней строки.
Mershik, первоначально мысль была такой, что если в умную таблицу добавляю новую строку (вниз или в ее середину), то при заполнении в этой новой строке ячеек (которые участвуют в маппинге с др.таблицей), данные переносятся в нее.
Если такое сложно отловить, то устроит вариант: я нахожусь в любой ячейке умной таблицы и по кнопке запускаю макрос, который из этой строки из определенных ячеек скопирует инфу в др.умную таблицу
bagdasarov86, работает так вносите строку - в столбце H пишите что-либо и все и строка копируется на другой лист в последнюю строку в модуль листа
можно еще сделать по двойному нажатию какой то ячейки строки
Код
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Cells.Count > 1 Then Exit Sub
If Not Intersect(Target, Range("H2:H100")) Is Nothing Then
With Worksheets("Ëèñò1")
lr = .Cells(Rows.Count, 1).End(xlUp).Row + 1
.Cells(lr, 1) = Target.Offset(0, -7)
.Cells(lr, 2) = Target.Offset(0, -6)
.Cells(lr, 3) = Target.Offset(0, -5)
.Cells(lr, 4) = ActiveSheet.Name
.Cells(lr, 6) = Target.Offset(0, -4)
.Cells(lr, 9) = Target.Offset(0, -1)
End With
End If
End Sub
Sub macro(control As IRibbonControl)
arr1 = Cells(ActiveCell.Row, 1).Resize(1, 3)
arr2 = Cells(ActiveCell.Row, 4).Resize(1, 4)
s = ActiveSheet.Name
With Sheets("Ëèñò1")
r = .[a1].End(xlDown).Row + 1
.Cells(r, 1).Resize(1, 3) = arr1
.Cells(r, 4) = s
.Cells(r, 5).Resize(1, 4) = arr2
End With
End Sub
цитирование - не бездумное копироание[МОДЕРАТОР] Mershik, спасибо. Чуть доработал по ячейке Cells(lr, 1). Чтобы код присваивался сам и копировался на исходную таблицу. Но дальше я захотел по итогам затереть значение в столбце H и добавил Target.Offset(0, 0) = "" Это приводит к какому-то зацикливанию и вылету. Что сделал не так?)
Код
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Cells.Count > 1 Then Exit Sub
If Not Intersect(Target, Range("H2:H100")) Is Nothing Then
With Worksheets("Лист1")
lr = .Cells(Rows.Count, 1).End(xlUp).Row + 1
.Cells(lr, 1) = .Cells(lr - 1, 1) + 1
.Cells(lr, 2) = Target.Offset(0, -6)
.Cells(lr, 3) = Target.Offset(0, -5)
.Cells(lr, 4) = ActiveSheet.Name
.Cells(lr, 6) = Target.Offset(0, -4)
.Cells(lr, 9) = Target.Offset(0, -1)
End With
With Worksheets("Зибель")
Target.Offset(0, -7) = Worksheets("Лист1").Cells(lr, 1)
Target.Offset(0, 0) = ""
End With
End If
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Cells.Count > 1 Then Exit Sub
If Not Intersect(Target, Range("H2:H100")) Is Nothing Then
With Worksheets("Лист1")
If IsEmpty(Target) Then Exit Sub
lr = .Cells(Rows.Count, 1).End(xlUp).Row + 1
.Cells(lr, 1) = .Cells(lr - 1, 1) + 1
.Cells(lr, 2) = Target.Offset(0, -6)
.Cells(lr, 3) = Target.Offset(0, -5)
.Cells(lr, 4) = ActiveSheet.Name
.Cells(lr, 6) = Target.Offset(0, -4)
.Cells(lr, 9) = Target.Offset(0, -1)
End With
With Worksheets("Зибель")
Target.Offset(0, -7) = Worksheets("Лист1").Cells(lr, 1)
Target = ""
End With
End If
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Cells.Count > 1 Then Exit Sub
If Not Intersect(Target, Range("H2:H100")) Is Nothing Then
If Target = "" Then Exit Sub
With Worksheets("Лист1")
lr = .Cells(Rows.Count, 1).End(xlUp).Row + 1
.Cells(lr, 1) = .Cells(lr - 1, 1) + 1
.Cells(lr, 2) = Target.Offset(0, -6)
.Cells(lr, 3) = Target.Offset(0, -5)
.Cells(lr, 4) = ActiveSheet.Name
.Cells(lr, 6) = Target.Offset(0, -4)
.Cells(lr, 9) = Target.Offset(0, -1)
End With
With Worksheets("Зибель")
Target.Offset(0, -7) = Worksheets("Лист1").Cells(lr, 1)
Target = ""
End With
End If
End Sub