Есть таблица (Лист Задачи), в которой ведется учет сотрудников, назначенных на Объекты. На каждый объект назначается сотрудник в столбце F. В столбцах G:АK планируются часы работы сотрудников. Бывают ситуации, когда основной работник уходит в отпуск и на Объект нужно назначить дополнительного работника . В столбце E, на против основного сотрудника, выбирается из выпадающего списка "треб. подмена", например, в строке 6 (E6). После этого выбора нужно, что бы срабатывал макрос, который сместит на строку ниже информацию из диапазона A7:AK (последняя не пустая строка), т.е. на A8:AK. А в строку 7 продублирует часть строки 6 - диапазон A6: D6 Есть макрос, который просто переносит информацию по кнопке. Помогите доработать его под мою задачу, если такое вообще возможно
Есть таблица (Лист Задачи), в которой ведется учет сотрудников, назначенных на Объекты. На каждый объект назначается сотрудник в столбце F. В столбцах G:АK планируются часы работы сотрудников. Бывают ситуации, когда основной работник уходит в отпуск и на Объект нужно назначить дополнительного работника . В столбце E, на против основного сотрудника, выбирается из выпадающего списка "треб. подмена", например, в строке 6 (E6). После этого выбора нужно, что бы срабатывал макрос, который сместит на строку ниже информацию из диапазона A7:AK (последняя не пустая строка), т.е. на A8:AK. А в строку 7 продублирует часть строки 6 - диапазон A6: D6 Есть макрос, который просто переносит информацию по кнопке. Помогите доработать его под мою задачу, если такое вообще возможноAlfa
Private Sub Worksheet_Change(ByVal Target As Range) If Not Intersect(Intersect(Range([E5], [E1].Offset([E:E].Rows.Count - 1)), UsedRange), Target) Is Nothing _ And Target.Count = 1 Then If Target.Value = "треб. подмена" Then Application.EnableEvents = False curr_row = Target.Row next_row = curr_row + 1 Rows(next_row).Insert Shift:=xlDown Range("A" & curr_row & ":D" & next_row).FillDown ' Range("A" & next_row & ":D" & next_row).Select Application.EnableEvents = True End If: End If End Sub
[/vba]Замечание: относительные ссылки формул новой строки смещаются на единицу в новой строке. Если так и надо, то и ладно, иначе - озвучьте как надо.
Alfa, в модуль листа "Задачи":[vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range) If Not Intersect(Intersect(Range([E5], [E1].Offset([E:E].Rows.Count - 1)), UsedRange), Target) Is Nothing _ And Target.Count = 1 Then If Target.Value = "треб. подмена" Then Application.EnableEvents = False curr_row = Target.Row next_row = curr_row + 1 Rows(next_row).Insert Shift:=xlDown Range("A" & curr_row & ":D" & next_row).FillDown ' Range("A" & next_row & ":D" & next_row).Select Application.EnableEvents = True End If: End If End Sub
[/vba]Замечание: относительные ссылки формул новой строки смещаются на единицу в новой строке. Если так и надо, то и ладно, иначе - озвучьте как надо.JayBhagavan
Языком ты или построишь жизнь,или разрушишь ее до основания.Думайте что говорите.(с)А.Хакимов