Страницы: 1
RSS
Запускать макрос при изменении значения ячейки
 
Здравствуйте Уважаемые!

Прошу вас о помощи в разработке макроса для личного домашнего проекта.

Есть ячейка A2 в которую я ввожу продукт. В ячейках B2-L2 заполняется информация о калориях с помощью ВПР с другого листа.

Последовательность задачи:
1. ввожу в A2 продукт, в B2 кол-во, ячейки C2-L2 заполнились.
2. макрос копирует ячейки I2-L2 в N3-N6 и перезаписывает их (не ссылка).
3. ввожу новую информацию в A2 и B2, ячейки B2-L2 заполнились новой информацией
4. макрос копирует ячейки I2-L2 в O3-O6 и перезаписывает их (не ссылка).
5. вручную очищаешь ячейки N3:O6 и макрос готов к работе снова с п.1. в дальнейшем заполняя данные в N3-N6
Запуск макроса я думаю можно решить с помощью чего-то вроде:
Код
Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Address = "$I$3" Then
        Call Макрос
    End If
End Sub


В I3 даю любую команду, или определенную команду текстом, например GO и макрос запустился.

С самим макросом разобраться не могу, помогите пожалуйста.

Пример задания прикрепляю.


С уважением,
Руслан
Изменено: Ruslan Romanoff - 09.08.2022 14:47:25
 
Код
Private Sub Worksheet_Change(ByVal Target As Range)
    Select Case Target.Address(0, 0)
    Case "B2"
        Dim arr As Variant
        arr = Range("I2:L2")
        
        Dim xx As Long
        xx = Cells(3, Columns.Count).End(xlToLeft).Column + 1
        xx = Application.Max(xx, [N1].Column)
        
        Cells(3, xx).Resize(UBound(arr, 2), 1) = Application.Transpose(arr)
    End Select
End Sub
 
Как можно быть такими умными и еще и такими оперативными?!

Огромное спасибо, как часы все работает!!!  :) :)  
 
МатросНаЗебре,

Я извиняюсь за еще один вопрос, у самого вышла ошибка при попытке поправить.

А как еще можно добавить чтобы в этом коде в N2 попало значение A2, в O2 значение A2 при последовательном заполнении соотв.

Очень благодарю заранее, в любом случае больша'я часть проблемы у меня уже решена :)
 
Код
Private Sub Worksheet_Change(ByVal Target As Range)
    Select Case Target.Address(0, 0)
    Case "B2"
        Dim arr As Variant
        arr = Range("I2:L2")
         
        Dim xx As Long
        xx = Cells(3, Columns.Count).End(xlToLeft).Column + 1
        xx = Application.Max(xx, [N1].Column)
         
        Application.EnableEvents = False
        Cells(2, xx).Value = Range("A2").Value
        Cells(3, xx).Resize(UBound(arr, 2), 1) = Application.Transpose(arr)
        Application.EnableEvents = True
    End Select
End Sub
 
МатросНаЗебре, Спасибо, вопрос решен благодаря Вам.
Страницы: 1
Наверх