Автоматическое создание нового листа в excel

Сегодня я покажу, как заполнить однотипные листы, по шаблону Excel на основе списка.

Переименуем в книге первый лист, это у нас будет список, допустим сотрудников.

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

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

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

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

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

Перейдём на вкладке Разработчик в Visual Basic либо нажмем Alt+F11, для того чтобы открылся редактор макросов.

Нажмем в меню insert – module, напишем модуль Sub ListTempl(), объявим переменную tmpName.

Получим данные нашего списка из листа список в переменную tmpName, объявив диапазон А1:А3. Но если нужно будет больше, то будем менять это значение. Пока в примере оставим так.

Напишем цикл for от 1 до 3, по сколько мы знаем конечное количество записей нашего списка и теперь сделаем копию листа шаблон, создадим новый лист копии листа с шаблоном, шаблон и присвоим имя каждому листу, значение то которое у нас находится в списке. Закончим цикл next i.

Теперь нажмем правой кнопкой на кнопке, назначить макрос, выберем макрос ListTempl, OK, сохранить.

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

Sub ListTempl()
Dim tmpName
tmpName = Sheets("Шаблон").Range("a1:a3")

For i = 1 To 3
Sheets("Шаблон").Copy Before:=Sheets(i)
Sheets(i).Name = tmpName(i, 1)
Next i

End Sub

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

Если нажать на кнопку повторно, то Excel выдаст ошибку, что подобные листы уже используется, надо учитывать этот момент, просто удалите дубли, в этом примере я не буду делать повторную проверку или добавление каких-то случайных значений к имени листов.

Давайте добавим теперь в шапку шаблона формулу, которая будет в ячейку присваивать имя листа, сейчас формула находится на листе с названием шаблон.

Эта формула позволяет получить из значение листа имя листа в ячейку, происходит разбор пути файла до листа.

=ПРОПНАЧ(ПСТР(ЯЧЕЙКА("имяфайла";A1);ПОИСК("]";ЯЧЕЙКА("имяфайла";A1))+1;99))

Давайте допишет для примера как это бывает в таблицах, «Список для », а далее будет фамилия поставляться из названия листа.

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

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

Если же всё-таки вам нужно будет сделать два листа для одной уникальной записи, тут могу предложить следующее.

Изменим в коде диапазон на А4, так как у нас ещё один пункт добавился и в цикле исправим на четыре.

Sub ListTempl()
Dim tmpName
tmpName = Sheets("Шаблон").Range("a1:a4")

For i = 1 To 4
Sheets("Шаблон").Copy Before:=Sheets(i)
Sheets(i).Name = tmpName(i, 1)
Next i

End Sub

Удалим всё снова и нажмем на кнопку. Опять ошибка, как вариант предлагаю добавить пробел в конце названия дублируемого пункта списка.

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

Смотрите видео: Листы в Excel из списка по шаблону

Понравилась статья? Поделитесь ею с друзьями и напишите отзыв в комментариях!

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

Создавайте новые листы для каждой строки с кодом VBA
Создавайте новые листы для каждой строки с помощью утилиты «Разделить данные». Kutools for Excel

Создавайте новые листы для каждой строки с кодом VBA

С помощью следующих кодов вы можете создать новый лист на основе значений столбца или просто создать новые листы для каждой строки в Excel.

1. Нажмите другой + F11 клавиши одновременно, чтобы открыть Microsoft Visual Basic для приложений окно.

2. в Microsoft Visual Basic для приложений окна, нажмите Вставить > Модули. А затем вставьте следующий код в Модули окно.

Код VBA: создать новый лист для каждой строки на основе столбца

Sub parse_data()
'Update by Extendoffice 2018/3/2
    Dim xRCount As Long
    Dim xSht As Worksheet
    Dim xNSht As Worksheet
    Dim I As Long
    Dim xTRrow As Integer
    Dim xCol As New Collection
    Dim xTitle As String
    Dim xSUpdate As Boolean
    Set xSht = ActiveSheet
    On Error Resume Next
    xRCount = xSht.Cells(xSht.Rows.Count, 1).End(xlUp).Row
    xTitle = "A1:C1"
    xTRrow = xSht.Range(xTitle).Cells(1).Row
    For I = 2 To xRCount
        Call xCol.Add(xSht.Cells(I, 1).Text, xSht.Cells(I, 1).Text)
    Next
    xSUpdate = Application.ScreenUpdating
    Application.ScreenUpdating = False
    For I = 1 To xCol.Count
        Call xSht.Range(xTitle).AutoFilter(1, CStr(xCol.Item(I)))
        Set xNSht = Nothing
        Set xNSht = Worksheets(CStr(xCol.Item(I)))
        If xNSht Is Nothing Then
            Set xNSht = Worksheets.Add(, Sheets(Sheets.Count))
            xNSht.Name = CStr(xCol.Item(I))
        Else
            xNSht.Move , Sheets(Sheets.Count)
        End If
        xSht.Range("A" & xTRrow & ":A" & xRCount).EntireRow.Copy xNSht.Range("A1")
        xNSht.Columns.AutoFit
    Next
    xSht.AutoFilterMode = False
    xSht.Activate
    Application.ScreenUpdating = xSUpdate
End Sub

Внимание: A1: C1 — диапазон заголовков вашей таблицы. Вы можете изменить его по своему усмотрению.

3. Нажмите F5 ключ для запуска кода, то новые рабочие листы будут созданы после всех рабочих листов текущей книги, как показано на скриншоте ниже:

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

Код VBA: напрямую создавать новый лист для каждой строки

Sub RowToSheet()
	Dim xRow As Long
	Dim I As Long
	With ActiveSheet
		xRow = .Range("A" & Rows.Count).End(xlUp).Row
		For I = 1 To xRow
			Worksheets.Add(, Sheets(Sheets.Count)).Name = "Row " & I
			.Rows(I).Copy Sheets("Row " & I).Range("A1")
		Next I
	End With
End Sub

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

Внимание: Строка заголовка также будет помещена на новый лист с этим кодом VBA.

Создавайте новые листы для каждой строки с помощью утилиты «Разделить данные». Kutools for Excel

На самом деле, описанный выше метод сложен и труден для понимания. В этом разделе мы познакомим вас с Разделить данные полезности Kutools for Excel.

1. Выберите таблицу, которую нужно использовать для создания новых листов, и нажмите Кутулс Плюс> Плевать данные. Смотрите скриншот:

2. в Разделить данные на несколько листов диалоговое окно, сделайте следующее.

A. Для создания новых листов на основе значения столбца:

Б. Для непосредственного создания новых листов для каждой строки:

создается новая книга со всеми новыми листами внутри. Смотрите скриншоты ниже.

Создание новых листов для каждой строки на основе значения столбца:

Создание нового листа для каждой строки без учета значения столбца:

  Если вы хотите получить бесплатную пробную версию (30-день) этой утилиты, пожалуйста, нажмите, чтобы загрузить это, а затем перейдите к применению операции в соответствии с указанными выше шагами.

Создавайте новые листы для каждой строки с помощью утилиты «Разделить данные». Kutools for Excel

Skip to content

Sub DobavitNoviiList()
'Шаг 1: Говорим Excel, что делать, если ошибка
On Error GoTo MyError
'Шаг 2: Добавляем лист
Sheets.Add
'Шаг 3: Присваиваем имя
ActiveSheet.Name = "Отчет"_
WorksheetFunction.Text(Now(),"yyyy")
'Шаг 4: Выходим
Exit Sub
'Шаг 5: Если произошла ошибка, сообщение пользователю
MyError:
MsgBox "Лист с таким именем уже есть!"
End Sub