Макрос для копирования и переименования листов Excel

В этом примере детально описана и разобрана автоматизация копирования и переименования листов Excel с исходными кодами макросов.

Как копировать и переименовать лист Excel макросом

Представьте ситуацию: Вы готовите планы работ для сотрудников определенного отдела фирмы. Пример таблицы плана выглядит так:

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

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

Техническое Задание (ТЗ) для макроса заключается в следующем. После выделения ячеек, которые содержат названия для листов нужно скопировать лист с шаблоном для планов работ ровно столько сколько будет выделенных ячеек и ввести соответствующие названия в ярлычки.

Примечание. В программировании, как и в многих других технических сферах деятельности (например, в бизнес-планировании) – без ТЗ результат ХЗ! Автор цитаты известный бизнесмен и предприниматель Дмитрий Потапенко.

Для этого сначала откройте редактор кода макроса: «РАЗРАБОТЧИК»-«Код»-«Visual Basic» (ALT+F11):

В редакторе создайте новый модуль выбрав инструмент «Insert»-«Module» и введите в него следующий код макроса:

Sub PlanRabot()
  Dim diapaz As Range
  Dim i As Long
  Dim list As Worksheet
On Error Resume Next
Set diapaz = Application.InputBox("Пожалуйста, выделите диапазон ячеек, который содержит названия для новых листов!", Type:=8)
On Error GoTo 0
If diapaz Is Nothing Then Exit Sub
Set list = ActiveSheet
For i = 1 To diapaz.Count
list.Copy after:=ActiveSheet
ActiveSheet.Name = Left(diapaz(i), 31)
Next
End Sub


Теперь если вы хотите скопировать лист шаблона для заполнения плана работ и создать копии плана для каждого сотрудника имена с фамилиями которых будут присвоены названиям листа, то перейдите на исходный лист с шаблоном плана работ и выберите инструмент: «РАЗРАБОТЧИК»-«Код»-«Макросы»-«PlanRabot»-«Выполнить». Сразу же после запуска макроса появиться диалоговое окно:

Теперь перейдите на лист «Имена и Фамилии» и выделите в нем диапазон ячеек, которые содержат имена и фамилии сотрудников. И нажмите на кнопку ОК.

В результате чего макрос сам автоматически скопирует планы работ для каждого сотрудника и присвоит новым листам соответственные имена и фамилии.



Описание исходного кода макроса для копирования и переименования листов

В начале кода макроса вызываем диалоговое окно для выделения диапазона ячеек на рабочем листе Excel и присвоения адреса диапазона в качестве значения для поля ввода данного диалогового окна.

Перед вызовом инструкции открытия диалогового окна отключается контроль ошибок. А после создания экземпляра объекта Range в переменной diapaz, снова включается контроль ошибок. Сделано так потому, что нажатие на кнопку «Отмена» в диалоговом окне вызовет ошибку выполнения макроса. Если же отключить обработку ошибок то, когда пользователь нажмет на кнопку «Отмена», тогда просто не будут выполняться никакие инструкции макроса.

В случаи если пользователь заполнил поле ввода и нажал на кнопку «ОК», тогда в переменную list присваиваться текущий рабочий лист. После чего внутри цикла он копируется ровно столько раз, сколько было выделено ячеек.

В процессе копирования каждому новому листу присваивается имя, которое берется из значения текущей ячейки из предварительно выделенного диапазона. Текст в ячейках обрезается до 31 символов, так как максимальная длинна наименования листа не может содержать более чем 31 символ.

Если необходимо сделать так чтобы соответственные имена и фамилии сотрудников были не только на ярлычках листов, а и в значении ячейки B1 в каждом листе, тогда перед строкой конца цикла Next добавьте следующую строку кода:

ActiveSheet.Range("B1") = diapaz(i)

Подобным способом можно вводить имена и названия для других ячеек листа. Достаточно указать желаемый адрес ячейки в кавычках.

Версия кода макроса с дополнительной строкой кода выглядит так:

Sub PlanRabot()
  Dim diapaz As Range
  Dim i As Long
  Dim list As Worksheet
On Error Resume Next
Set diapaz = Application.InputBox("Пожалуйста, выделите диапазон ячеек, который содержит названия для новых листов!", Type:=8)
On Error GoTo 0
If diapaz Is Nothing Then Exit Sub
Set list = ActiveSheet
For i = 1 To diapaz.Count
list.Copy after:=ActiveSheet
ActiveSheet.Name = Left(diapaz(i), 31)
ActiveSheet.Range("B1") = diapaz(i)
Next
End Sub


Пример вставки имен и фамилий не только в ярлычки листов, а и в их определенные пользователем ячейки:

Читайте также: Макрос для копирования листов Excel с заданным количеством копий.

Таким образом, благодаря макросу в пару кликов мышкой можно выполнить большой объем работы. В данном примере скопировано копий только для 8-ми сотрудников. Особенно ощутимую пользу приносит данный макрос при необходимости копировать большое количество листов. Ведь в некоторых фирмах количество сотрудников, заполняющих планы работы, может превышать 100 человек и более.