Здравствуйте! Некоторое время назад мне помогли на данном форуме с макросом. Применила его уже во многих файлах, чем облегчила намного свою работу и конечно же благодарна тому, кто помог. Так как про макросы имею общее представление и написанием их не обладаю, надеюсь еще получить помощь в написании макроса под мою задачу. Есть таблица для заполнения данных по сотрудникам.Количество столбцов (показателей) для каждого сотрудника одинаково (в таблице выделено синей границей).Количество самих сотрудников не постоянно и их количество определяется значением в ячейке А1.Количество строк в таблице тоже не постоянно (может быть больше или меньше, изменяется по ходу заполнения и тоже при помощи макроса "Вставить строку над последней строкой в таблице"). Последней строке в таблице и диапазону с ячейками (показателями) (C4:J41) присвоены имена "последняя" и "шаблон" соответственно.
ЗАДАЧА: В таблицу справа добавлять шаблоны для заполнения показателей для новых сотрудников столько раз, сколько указано в ячейке А1. Макрос хочу применять для каждой таблицы месяца.
На форумах нашелся подходящий макрос, но он добавляет именно столбцы на всю их, так сказать, длину вниз, а у меня таблицы заполняются на каждый месяц и находятся друг под другом на одном листе, соответственно нарушается вся последовательность этих таблиц.
Код
Sub ДобавитьРаздел()
Columns("C:J").Copy
Columns(Cells(6, Columns.Count).End(xlToLeft).Column + 1).Insert xlToRight
Application.CutCopyMode = False
End Sub
Эксель 2010 год.
Да, еще момент, добавление нового шаблона в таблицу, должно быть с сохранением и копированием форматов и формул исходного шаблона.
Ничего не понял. Покажите в файле как выглядит таблица до применения макроса и какой она должна получиться после применения макроса. Заполните одну-две строки в таблицах и покажите что и куда должно добавиться после срабатывания макроса.
Вариант в файле. Но используя именованный диапазон "шаблон" с рабочего лист, будут копироваться заполненные данные за январь в другие места. Лучше создать чистый шаблон без данных на отдельном листе и скрыть этот лист чтобы он не мешал.
_Igor_61, в ячейке А1 будет указываться (формулой счета с других листов книги) количество сотрудников для которых в таблицу нужно добавить графы (столбцы) для заполнения показателей. Добавила в файл информацию, как должно быть после выполнения макроса (на двух сотрудников (ячейка А1) добавлено два диапазона столбцов по исходному шаблону с сохранением форматов и копированием формул).
Здравствуйте! gling,все работает отлично. Спасибо. Я привязала макрос к каждой таблице месяца, добавив в них ячейку с количеством сотрудников и изменив ссылку на ячейку с названием месяца, ну и соответственно изменив именованный диапазон шаблона (это к тому, что вы предлагали вынести шаблон на отдельный лист). Первые столбцы шаблона в таблицах будут чистыми (исходниками) и чтобы их не заполняли, будут скрываться после копирования и добавления новых шаблонов (макрорекордером написала макрос на срытие и отображение столбцов). Единственный момент, который не смогла сама поправить, при добавлении новых шаблонов не сохраняется ширина столбцов, как в исходном шаблоне. Попыталась отдельно записать макрорекордером процедуру вставки столбцов с сохранением их ширины, но внедрить в Ваш макрос не получается (не срабатывает). Подскажите, что нужно для этого дописать в Вашем макросе.
Здравствуйте! Kuzmich, спасибо. В этом варианте сохраняется ширина столбцов исходного шаблона, но не сохраняются форматы и формулы, всё вставляется просто как значение (даже нет границ таблицы). Может не правильно добавила в макрос?
Макрос предложенный gling, (в этом варианте форматы и формулы исходника сохраняются)
Код
Sub ВставитьШаблонЯнварь()
Dim i As Long, j As Long, k As Long
On Error Resume Next
i = Application.Match(Range("B5").Value, Range("B:B"), 0) - 1
k = 11
For j = 1 To Range("A6").Value
Range("шаблон").Copy Cells(i, k)
k = k + 8
Next
End Sub
и последний вариант
Код
Sub ВставитьШаблонЯнварь()
Dim i As Long, j As Long, k As Long
On Error Resume Next
i = Application.Match(Range("B5").Value, Range("B:B"), 0) - 1
k = 11
For j = 1 To Range("A6").Value
Range("шаблон").Copy
Cells(i, k).PasteSpecial xlPasteColumnWidths
Cells(i, k).PasteSpecial xlPasteValues
k = k + 8
Next
End Sub
Sub ВставШабл()
Dim i As Long, j As Long, k As Long
On Error Resume Next
i = Application.Match(Range("C1").Value, Range("B:B"), 0) - 1
k = 11
Application.DisplayAlerts = False
For j = 1 To Range("A1").Value
Range("шаблон").Copy Cells(i, k)
Range("шаблон").Copy
Cells(i, k).PasteSpecial xlPasteColumnWidths
k = k + 8
Next
Application.DisplayAlerts = True
End Sub
xlPasteValues - вставить значения, поэтому у Вас формулы и исчезали xlPasteColumnWidths - вставить ширины столбцов
В этом варианте сохраняется ширина столбцов исходного шаблона, но не сохраняются форматы и формулы
Обязательно почитайте в справке про PasteSpecial, там есть разные варианты вставки значений, формул, форматов и т.д.
Код
Sub ВставШабл()
Dim i As Long, j As Long, k As Long
On Error Resume Next
i = Application.Match(Range("C1").Value, Range("B:B"), 0) - 1
k = 11
For j = 1 To Range("A1").Value
Range("шаблон").Copy
Cells(i, k).PasteSpecial xlPasteColumnWidths
Cells(i, k).PasteSpecial xlPasteAll
k = k + 8
Next
End Sub