Поиск  Пользователи  Правила 
Закрыть
Логин:
Пароль:
Забыли свой пароль?
Регистрация
Войти
 
Страницы: 1
RSS
Копировать значения из новой строки в умной таблице в новую строку другой таблицы
 
Добрый день. Помогите, пожалуйста, написать макрос.

Задача:
Если на листе "Зибель" в умной таблице "Таблица13" появляется новая строка (путем стандартного добавления или путем записи в строку снизу новых данных), то необходимо копировать значения конкретных ячеек (после ввода значения в ячейку, находящейся в этой новой добавленной строке) на лист "Лист1" в умную таблицу "Таблица1", предварительно добавив новую строку внизу таблицы.

Ожидаемый результат: в умной таблице на Листе1 добавилась снизу новая строка, значения подставились в эту строку по маппингу, а в ячейку D6 подставилась константа "Зибель".

Файл прилагаю.

бюджет - 300 р.
Изменено: bagdasarov86 - 23 Май 2020 21:00:43
 
bagdasarov86, макросы нагуглил и подогнал вроде, а вот на событие повесить не смог
 
Нашел вариант на событие на сайте.
Вроде работает, только комментарии в первую очередь надо заполнять
Еще событие не срабатывает, если в Таблица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
Изменено: Mershik - 23 Май 2020 22:31:45
 
вариант - повесить на контекстуню менюшку:
Скрытый текст
123.jpg (90.02 КБ)
Изменено: buchlotnik - 23 Май 2020 23:13:52
Каждому For свой Next
 
цитирование - не бездумное копироание[МОДЕРАТОР]
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
 
bagdasarov86, так?
Код
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


 
Так тоже вылетает (Target = ""), файл закрывается

Цитата
buchlotnik написал: вариант - повесить на контекстуню менюшку:
buchlotnik, заценил. Огонь!!!  
 
bagdasarov86,
Код
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
Страницы: 1
Читают тему (гостей: 1)
Наверх