跳到主要內容

如何從單元格值列表中創建多個工作表?

是否有任何快速或簡便的方法讓我們根據Excel中的單元格值列表創建多個工作表? 在本文中,我將討論解決此工作的一些好技巧。

使用VBA代碼從單元格值列表中創建多個工作表

使用Kutools for Excel從單元格值列表中創建多個工作表


箭頭藍色右氣泡 使用VBA代碼從單元格值列表中創建多個工作表

若要快速創建多個以單元格值列表命名的新工作表,以下VBA代碼可以為您提供幫助。

1。 按住 ALT + F11 鍵打開 Microsoft Visual Basic for Applications 窗口。

2。 點擊 插入 > 模塊,然後將以下代碼粘貼到 模塊 窗口。

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 for Excel從單元格值列表中創建多個工作表

如果您不熟悉上述代碼,可以使用以下便捷工具-Excel的Kutools,其 創建序列工作表 函數,將基於新工作簿中的單元格值創建工作表。

Excel的Kutools : 帶有300多個便捷的Excel加載項,可以在30天內免費試用. 

安裝後 Excel的Kutools,請這樣做:

1。 點擊 Kutools 加 > 下載學習單 > 創建序列工作表,請參見屏幕截圖:

2。 在 創建序列工作表 對話框:

(1.)選擇一個您要基於其創建序列工作表的工作表;

(2.)然後選擇 數據 在範圍選項中 工作表名稱基於 列錶框,然後單擊 doc創建多個工作表4 按鈕選擇要使用的單元格值。

doc創建多個工作表3

3。 然後點擊 Ok 按鈕,已經在新工作簿中使用單元格值的名稱創建了工作表,請參見屏幕截圖:

doc創建多個工作表5

點擊立即下載並免費試用Kutools for Excel!

最佳辦公生產力工具

🤖 Kutools 人工智慧助手:基於以下內容徹底改變數據分析: 智慧執行   |  生成代碼  |  建立自訂公式  |  分析數據並產生圖表  |  呼叫 Kutools 函數...
熱門特色: 尋找、突出顯示或識別重複項   |  刪除空白行   |  合併列或儲存格而不遺失數據   |   沒有公式的回合 ...
超級查詢: 多條件VLookup    多值VLookup  |   跨多個工作表的 VLookup   |   模糊查詢 ....
高級下拉列表: 快速建立下拉列表   |  依賴下拉列表   |  多選下拉列表 ....
欄目經理: 新增特定數量的列  |  移動列  |  切換隱藏列的可見性狀態  |  比較範圍和列 ...
特色功能: 網格焦點   |  設計圖   |   大方程式酒吧    工作簿和工作表管理器   |  資源庫 (自動文字)   |  日期選擇器   |  合併工作表   |  加密/解密單元格    按清單發送電子郵件   |  超級濾鏡   |   特殊過濾器 (過濾粗體/斜體/刪除線...)...
前 15 個工具集12 文本 工具 (添加文本, 刪除字符,...)   |   50+ 圖表 類型 (甘特圖,...)   |   40+ 實用 公式 (根據生日計算年齡,...)   |   19 插入 工具 (插入二維碼, 從路徑插入圖片,...)   |   12 轉化 工具 (數字到單詞, 貨幣兌換,...)   |   7 合併與拆分 工具 (高級合併行, 分裂細胞,...)   |   ... 和更多

使用 Kutools for Excel 增強您的 Excel 技能,體驗前所未有的效率。 Kutools for Excel 提供了 300 多種進階功能來提高生產力並節省時間。  點擊此處獲取您最需要的功能...

產品描述


Office選項卡為Office帶來了選項卡式界面,使您的工作更加輕鬆

  • 在Word,Excel,PowerPoint中啟用選項卡式編輯和閱讀,發布者,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