Редактирование готовой таблицы без нарушения ее функциональности

[Noki]

Добрый день, друзья,
помогите пож-та.

У меня есть таблица в excel с макросами, кнопками и т.п. Мне нужно добавить в эту таблицу еще столбцов. Если их просто вставлять, естественно, все макросы сбиваются.
Я понимаю, что задача очень простая, но для неграмотных она остается чересчур сложной.
Мог бы мне кто помочь? Безвозмездно или возмездно, это уже как нужно будет

Сам пробую, но у меня очень тяжко это выходит, а во времени, как всегда, мы все ограничены.

Прикрепил архив, в нем 2 таблички: одна - оригинал, вторая - то, что нужно.
Все добавленные столбцы выделил желтым.
Проблема в том, что при нажатии кнопок "добавить контакт" значения, которые должны подставляться автоматически - сбиваются на то число столбцов, которое я и добавил.
В табличке 2 листа, на обоих ситуация одинаковая.
Также со второго листа информация еще перемещается на первый и, соответственно, тоже сбивается.


Буду очень признателен за помощь.

[VictorM]

понимаю, что задача очень простая

Вот уж не сказал-бы.
Не знаю, может меня поправят более опытные, но на мой взгляд, задача как раз -таки довольно муторная и обьем работы большой.
Переписывать все адреса в макросах...
или же вставлять сдвиг на то количество столбцов, что вставлялись.
все равно переписывать
p.s.
Глянул макрос, вроде небольшой
позанимайтесь со строками типа вот этой
cell.Offset(-1, 7).Copy Destination:=cell.Offset(0, 7)
измените нужные сдвиги

[Noki]

Сообщение от VictorM

Вот уж не сказал-бы.
Не знаю, может меня поправят более опытные, но на мой взгляд, задача как раз -таки довольно муторная и обьем работы большой.
Переписывать все адреса в макросах...
или же вставлять сдвиг на то количество столбцов, что вставлялись.
все равно переписывать

По крайней мере опытным легче сразу увидеть где какую цифру поменять, нежели мне. Я больше про это имел в виду.
Соглашусь, что может быть муторно.
Если направить меня в нужном направлении где какие цифры поменять, то я наверно и сам справлюсь

[VictorM]

В макросе NEW_LINE_2 назначенному кнопке "Добавить контакт"
в строке
Set cell = ActiveSheet.Cells(65000, 4).End(xlUp).Offset(1, 0)
замените 4 на 7, т.е. так
Set cell = ActiveSheet.Cells(65000, 7).End(xlUp).Offset(1, 0)
если я правильно понял - все работает.

Sub NEW_LINE_2()
    Worksheets("Активные клиенты").Activate
    ActiveSheet.Unprotect Password:="1111"
    Dim cell As Object
    Set cell = ActiveSheet.Cells(65000, 7).End(xlUp).Offset(1, 0)
    cell.FormulaLocal = VBA.Format(VBA.Now, "DD.MM.YYYY")    '"=СЕГОДНЯ()" Дата установления статуса
    'cell.Offset(-1, 4).Copy Destination:=cell.Offset(0, 4)
    cell.Offset(-1, 7).Copy Destination:=cell.Offset(0, 7)    'статус клиента
    cell.Offset(-1, 8).Copy Destination:=cell.Offset(0, 8)    'дата посл контакта
    cell.Offset(-1, 9).Copy Destination:=cell.Offset(0, 9)    'дата след контакта
    cell.Offset(-1, 10).Copy Destination:=cell.Offset(0, 10)    'тип контакта
    cell.Offset(-1, 11).Copy Destination:=cell.Offset(0, 11)    'коментарий к действию
    ActiveSheet.Protect Password:="1111"
End Sub

[kuklp]

То же:

Sub NEW_LINE_2()
    With ['Активные клиенты'!G65000].End(xlUp)(2)
    .Parent.Unprotect "1111": .Value = Date
    .Offset(-1, 7).Resize(, 5).Copy .Offset(0, 7)
    .Parent.Protect "1111": .Parent.Activate
    End With
End Sub

Еще если при первой защите указать UserInterfaceOnly:=true, то все последующие
.Unprotect, .protect можно убрать. Т.е. отстанется только:

Sub NEW_LINE_2_1()
    With ['Активные клиенты'!G65000].End(xlUp)(2)
    .Value = Date
    .Offset(-1, 7).Resize(, 5).Copy .Offset(0, 7)
    End With
End Sub

[Noki]

Сообщение от VictorM

В макросе NEW_LINE_2 назначенному кнопке "Добавить контакт"
в строке
Set cell = ActiveSheet.Cells(65000, 4).End(xlUp).Offset(1, 0)
замените 4 на 7, т.е. так
Set cell = ActiveSheet.Cells(65000, 7).End(xlUp).Offset(1, 0)
если я правильно понял - все работает.

Sub NEW_LINE_2()
    Worksheets("Активные клиенты").Activate
    ActiveSheet.Unprotect Password:="1111"
    Dim cell As Object
    Set cell = ActiveSheet.Cells(65000, 7).End(xlUp).Offset(1, 0)
    cell.FormulaLocal = VBA.Format(VBA.Now, "DD.MM.YYYY")    '"=СЕГОДНЯ()" Дата установления статуса
    'cell.Offset(-1, 4).Copy Destination:=cell.Offset(0, 4)
    cell.Offset(-1, 7).Copy Destination:=cell.Offset(0, 7)    'статус клиента
    cell.Offset(-1, 8).Copy Destination:=cell.Offset(0, 8)    'дата посл контакта
    cell.Offset(-1, 9).Copy Destination:=cell.Offset(0, 9)    'дата след контакта
    cell.Offset(-1, 10).Copy Destination:=cell.Offset(0, 10)    'тип контакта
    cell.Offset(-1, 11).Copy Destination:=cell.Offset(0, 11)    'коментарий к действию
    ActiveSheet.Protect Password:="1111"
End Sub

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

[Noki]

Сообщение от kuklp

То же:

Sub NEW_LINE_2()
    With ['Активные клиенты'!G65000].End(xlUp)(2)
    .Parent.Unprotect "1111": .Value = Date
    .Offset(-1, 7).Resize(, 5).Copy .Offset(0, 7)
    .Parent.Protect "1111": .Parent.Activate
    End With
End Sub

Еще если при первой защите указать UserInterfaceOnly:=true, то все последующие
.Unprotect, .protect можно убрать. Т.е. отстанется только:

Sub NEW_LINE_2_1()
    With ['Активные клиенты'!G65000].End(xlUp)(2)
    .Value = Date
    .Offset(-1, 7).Resize(, 5).Copy .Offset(0, 7)
    End With
End Sub

здесь я если честно запутался это нужно добавить или заменить? у меня что то вобще перестает все работать..

[VictorM]

Осталось только поменять числа для столбцов, которые в оригинале с К по О.

Менять уже ничего не нужно, все вставляется куда надо.
пробуйте
хотя...Вам виднее))

[kuklp]

Что перестает?

[Noki]

Сообщение от kuklp

Что перестает?

если говорить про исправленный вариант, то в блоке "ТЕКУЩИЙ СТАТУС работы с КЛИЕНТОМ (итоговая информация).** Заполняется автоматически", который расположен в столбцах с N по R, при добавлении контакта не встает формула в столбец N и О.
В стобце BE и BG пропал выпадающий список (и в остальных таких же столбцах таблицы)