Прескочи на основното съдържание

Как да създадете няколко работни листа от списък със стойности на клетки?

Автор: Xiaoyang Последна промяна: 2020-05-25

Има ли бързи или лесни методи за създаване на множество работни листове въз основа на списък със стойности на клетки в Excel? В тази статия ще говоря за някои добри трикове за решаване на тази задача.

Създайте няколко работни листа от списък със стойности на клетки с VBA код

Създайте множество работни листове от списък със стойности на клетки с Kutools за Excel


стрелка син десен балон Създайте няколко работни листа от списък със стойности на клетки с VBA код

За бързо създаване на множество нови работни листове, които са наименувани със списък от стойности на клетки, следният VBA код може да ви помогне.

1. Задръжте натиснат ALT + F11 за да отворите Microsoft Visual Basic за приложения прозорец.

2. Щракнете Поставете > Модулии поставете следния код в Модули Window.

VBA код: Създайте няколко работни листа от списък с клетки:

Sub AddSheets()
'Updateby Extendoffice
    Dim xRg As Excel.Range
    Dim wSh As Excel.Worksheet
    Dim wBk As Excel.Workbook
    Set wSh = ActiveSheet
    Set wBk = ActiveWorkbook
    Application.ScreenUpdating = False
    For Each xRg In wSh.Range("A1:A7")
        With wBk
            .Sheets.Add after:=.Sheets(.Sheets.Count)
            On Error Resume Next
            ActiveSheet.Name = xRg.Value
            If Err.Number = 1004 Then
              Debug.Print xRg.Value & " already used as a sheet name"
            End If
            On Error GoTo 0
        End With
    Next xRg
    Application.ScreenUpdating = True
End Sub

Забележка: В горния код, A1: A7 е диапазонът от клетки, въз основа на който искате да създадете листове, моля, променете го според вашите нужди.

3. След това натиснете F5 ключ за изпълнение на този код и новите листове са създадени след всички листове в текущата работна книга, вижте екранната снимка:

doc създаване на няколко листа 1


стрелка син десен балон Създайте множество работни листове от списък със стойности на клетки с Kutools за Excel

Ако не сте опитни с горния код, ето един удобен инструмент -Kutools за Excel, Със своята Създаване на работни листове за последователност функция, работните листове ще бъдат създадени въз основа на стойностите на клетките в нова работна книга.

Kutools за Excel : с повече от 300 удобни добавки за Excel, безплатни за изпробване без ограничение за 30 дни. 

След инсталиране Kutools за Excel, моля, направете следното:

1. Щракнете Kutools плюс > Работен лист > Създаване на работни листове за последователност, вижте екранна снимка:

2. В Създаване на работни листове за последователност диалогов прозорец:

(1.) Изберете един работен лист, въз основа на който искате да създадете последователни работни листове;

(2.) След това изберете Дата в гама вариант от Имена на листове, базирани на списъчно поле и щракнете doc създаване на няколко листа 4 бутон, за да изберете стойностите на клетките, които искате да използвате.

doc създаване на няколко листа 3

3, И после щракнете върху Ok работните листове са създадени с имената на стойностите на клетките в нова работна книга, вижте екранната снимка:

doc създаване на няколко листа 5

Щракнете върху Изтегляне и безплатна пробна версия Kutools за Excel сега!

Най-добрите инструменти за продуктивност в офиса

🤖 Kutools AI помощник: Революционизирайте анализа на данни въз основа на: Интелигентно изпълнение   |  Генериране на код  |  Създаване на персонализирани формули  |  Анализирайте данни и генерирайте диаграми  |  Извикване на функциите на Kutools...
Популярни функции: Намерете, маркирайте или идентифицирайте дубликати   |  Изтриване на празни редове   |  Комбинирайте колони или клетки без загуба на данни   |   Кръг без формула ...
Супер търсене: VLookup с множество критерии    VLookup с множество стойности  |   VLookup в няколко листа   |   Размито търсене ....
Разширен падащ списък: Бързо създаване на падащ списък   |  Зависим падащ списък   |  Падащ списък с множество избори ....
Мениджър на колони: Добавете конкретен брой колони  |  Преместване на колони  |  Превключване на състоянието на видимост на скритите колони  |  Сравнете диапазони и колони ...
Препоръчани функции: Мрежов фокус   |  Изглед на дизайна   |   Голям формула бар    Мениджър на работни книги и листове   |  Библиотека с ресурси (Автоматичен текст)   |  Избор на дата   |  Комбинирайте работни листове   |  Шифроване/декриптиране на клетки    Изпращайте имейли по списък   |  Супер филтър   |   Специален филтър (филтър получер/курсив/зачертано...) ...
Топ 15 комплекта инструменти12 Текст Инструменти (добавяне на текст, Премахване на символи, ...)   |   50 + Графика Видове (диаграма на Гант, ...)   |   40+ Практичен формули (Изчислете възрастта въз основа на рождения ден, ...)   |   19 вмъкване Инструменти (Въведете QR код, Вмъкване на картина от пътя, ...)   |   12 Конверсия Инструменти (Числа към думи, Валутен обмен, ...)   |   7 Обединяване и разделяне Инструменти (Разширено комбиниране на редове, Разделени клетки, ...)   |   ... и още

Усъвършенствайте уменията си за Excel с Kutools за Excel и изпитайте ефективност, както никога досега. Kutools за Excel предлага над 300 разширени функции за повишаване на производителността и спестяване на време.  Щракнете тук, за да получите функцията, от която се нуждаете най-много...

Описание


Раздел Office Внася интерфейс с раздели в Office и прави работата ви много по-лесна

  • Разрешете редактиране и четене с раздели в Word, Excel, PowerPoint, Publisher, Access, Visio и Project.
  • Отваряйте и създавайте множество документи в нови раздели на един и същ прозорец, а не в нови прозорци.
  • Увеличава вашата производителност с 50% и намалява стотици кликвания на мишката за вас всеки ден!
Comments (20)
No ratings yet. Be the first to rate!
This comment was minimized by the moderator on the site
Hi
I would like to copy my "Vorlage" spreadsheet as many times as my "Stände" spreadsheet specifies. At the same time, the new sheets are also to be named according to a list from the "Stände" spreadsheet (item A1:A85).
Thank you in advance!
This comment was minimized by the moderator on the site
hello skyyang
i have try this code but it is create blank sheet
i want copy of active sheets
any idea....
This comment was minimized by the moderator on the site
Et si la liste est mouvante? car si j'ajoute des éléments dois-je tout le temps réadapter le code?
Merci
This comment was minimized by the moderator on the site
Hello, Lucas
To solve your problem, please apply the below code:
Please right click the sheet tab, and select View Code, then copy and paste the code into the Sheet Code window.
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim xRg As Excel.Range
    Dim wSh As Excel.Worksheet
    Dim wBk As Excel.Workbook
    Dim xAddress As String
    Dim xWSH As Worksheet
    Dim xRgI As Range
    Set wSh = ActiveSheet
    Set wBk = ActiveWorkbook
    xAddress = "A2:A20"
    On Error Resume Next
    Set xRgI = Intersect(Range(xAddress), Target)
    If xRgI Is Nothing Then Exit Sub
    If Target.Value = "" Then Exit Sub
    Application.ScreenUpdating = False
    Set xWSH = wBk.Worksheets.Item(Target.Value)
    If xWSH Is Nothing Then
      Set xWSH = wBk.Worksheets.Add
        xWSH.Name = Target.Value
        If Err.Number = 1004 Then
            Debug.Print xRg.Value & " already used as a sheet name"
        End If
    End If
    wSh.Activate
    Application.ScreenUpdating = True
End Sub

https://www.extendoffice.com/images/stories/comments/comment-skyyang/2023-comment/doc-sheets-from-cells.png
After pasting the code, now, you can enter the content into the specified cells, and then press Enter key, the new sheet will be created automatically.
Please have a try, hope it can help you!
This comment was minimized by the moderator on the site
Thanks you for posting this.
but i have problem with this code it is add blank sheets i want to copy and add the sheets
any idea for this??
This comment was minimized by the moderator on the site
Hello, Niks,

To solve your problem, please apply the below code:
Please right click the sheet tab, and select View Code, then copy and paste the code into the Sheet Code window.
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim xRg As Range
    Dim wSh As Worksheet
    Dim wBk As Workbook
    Dim xAddress As String
    Dim xWSH As Worksheet
    Dim xRgI As Range
    
    Set wSh = ActiveSheet
    Set wBk = ActiveWorkbook
    xAddress = "A2:A20"
    
    On Error Resume Next
    Set xRgI = Intersect(Range(xAddress), Target)
    On Error GoTo 0
    
    If xRgI Is Nothing Then Exit Sub
    If Target.Value = "" Then Exit Sub
    
    Application.ScreenUpdating = False
    
    Set xWSH = Nothing
    On Error Resume Next
    Set xWSH = wBk.Worksheets(Target.Value)
    On Error GoTo 0
    
    If xWSH Is Nothing Then
        On Error Resume Next
        Set xWSH = wBk.Worksheets.Add(After:=wBk.Worksheets(wBk.Worksheets.Count))
        On Error GoTo 0
        
        If Not xWSH Is Nothing Then
            xWSH.Name = Target.Value
            wSh.Cells.Copy Destination:=xWSH.Cells(1, 1)
        End If
    End If
    
    wSh.Activate
    Application.ScreenUpdating = True
End Sub


After pasting the code, when a value is entered in the specified range, a new worksheet is created based on that value, and the entire content of the current worksheet is copied to the newly created worksheet.

Please try, hope it can help you!
This comment was minimized by the moderator on the site
Thank you for posting this. I followed the directions and it worked perfectly.
This comment was minimized by the moderator on the site
I tried using the VBA code, it is creating "nameless" worksheets, so sheet1 , 2 , 3 and so on, rather than using the value in the cell as the sheet's name. I tried to fixed by changing the data type in the cell to text , same issue…


any ideas?
This comment was minimized by the moderator on the site
I had this issue. to correct: 1. only 31 characters allowed for worksheet names2. no special characters + = ( ) [ ] \ / , : etc...find and replace with a space
This comment was minimized by the moderator on the site
This is of great help. I could save so much time. Thank you so much for your time and for helping us with your wonderful code.
This comment was minimized by the moderator on the site
This works great, how could you incorporate a template into each created tab? i.e. copy and paste from a template into each newly created sheet
This comment was minimized by the moderator on the site
First time using VBA code in Excel. Worked perfectly on the first try. Thanks for posting this.
This comment was minimized by the moderator on the site
and it creates a lot of sheets even if the list is empty... what if i want to create sheets based on cells that have value?
This comment was minimized by the moderator on the site
Better version. This will delete created sheet if exist another sheet with the same name. And added inputbox to avoid from manual code modification to select range.


Sub AddSheetsFromCells()

Dim xRg As Range, wBk As Workbook
Set wBk = ActiveWorkbook

On Error GoTo Quit
Set dbRange = Application.InputBox("Range: ", "Select Range", _
Application.Selection.Address, Type:=8)

Application.ScreenUpdating = False
Application.DisplayAlerts = False

For Each xRg In dbRange
With wBk
.Sheets.Add After:=.Sheets(.Sheets.Count)
On Error Resume Next
ActiveSheet.Name = xRg.Value
If Err.Number = 1004 Then
Debug.Print Chr(34) & xRg.Value & Chr(34) & " already used as a sheet name"
.ActiveSheet.Delete
End If
On Error GoTo 0
End With
Next xRg

Application.ScreenUpdating = True
Application.DisplayAlerts = True
Quit:

End Sub
This comment was minimized by the moderator on the site
this is awesome...... thank-you very much .is there somewhere where there is a public repository for vba codes?
This comment was minimized by the moderator on the site
What if i wanted each newly created sheet to have a template pasted into it from a template sheet? The template would have formatting and formulas only

Thanks
This comment was minimized by the moderator on the site
i also need to know this. did u figure out ?
This comment was minimized by the moderator on the site
Sub UpdateMAPs()
Dim LR As Long, i As Long
Application.ScreenUpdating = False
With Sheets("Team List")
LR = .Range("E" & Rows.Count).End(xlUp).Row
For i = 2 To LR
Sheets("Blank MAP").Copy Before:=Sheets("Blank MAP")
ActiveSheet.Name = .Range("E" & i).Value
Next i
End With
Application.ScreenUpdating = True
End Sub

this worked for me from https://www.mrexcel.com/forum/excel-questions/553308-copy-worksheet-rename-cell-value.html
This comment was minimized by the moderator on the site
This is amazing! Thank you so much!
This comment was minimized by the moderator on the site
This appears to work great for what I am attempting to do with one exception... It is creating blank worksheets... I want to create a copy of an existing worksheet for each row in another worksheet. Is there anyway to do that?
There are no comments posted here yet
Please leave your comments in English
Posting as Guest
×
Rate this post:
0   Characters
Suggested Locations