Excel 将模板复制到新的工作表中，使用单元格中的名称

我创建了一个生成新工作表的工作簿，其中新工作表的名称取自第一个工作表中的单元格

我希望这些新的表格是另一张表格的副本

因此，在“处置”表中，我将姓名写在“a2:a2000”范围内。233

233将成为新的工作表，它是工作表“模板”的副本

我没有VBA方面的经验，所以代码是我在线资助和修改的

我已尝试更改工作表。添加到工作表（模板）。复制

但这似乎不起作用

Sub CreateSheets()
    Dim StartSheet As Worksheet
    Set StartSheet = ActiveSheet
    Dim rng As Range
    Dim cell As Range
    On Error GoTo Errorhandling
    
    If MsgBox("Opret ark baseret på løbenumre?", vbYesNo + vbQuestion) = vbNo Then
    Exit Sub
    End If
    
    Set rng = Range("A2:a2000")
    For Each cell In rng
        If cell <> "" Then
            Worksheets.Add(After:=Worksheets("disposition")).Name = cell
            Sheets("Template").Copy Worksheets(cell).Range("A1")
        End If
    Next cell
    
    Errorhandling:
    StartSheet.Activate
End Sub

Sub-CreateSheets（）
将起始表变暗为工作表
设置StartSheet=ActiveSheet
变暗rng As范围
暗淡单元格作为范围
关于错误转到错误处理
如果MsgBox（“Opret ark baseret påløbenumre？”，vbYesNo+vbQuestion）=vbNo，则
出口接头
如果结束
设置rng=范围（“A2:a2000”）
对于rng中的每个单元
如果是单元格“”，则
工作表。添加（在：=工作表（“处置”）之后）。名称=单元格
工作表（“模板”）。复制工作表（单元格）。范围（“A1”）
如果结束
下一个细胞
错误处理：
启动表，激活
端接头

无需添加新工作表，只需使用以下命令直接复制即可：

如果单元格为“”，则
工作表（“模板”）。之后复制：=工作表（“处置”）在处置后添加模板表的副本
工作表（工作表（“处置”）.Index+1.Name=cell.value”重命名新添加的模板副本（在处置表之后为+1）
如果结束

无需添加新工作表，只需使用以下命令直接复制即可：

如果单元格为“”，则
工作表（“模板”）。之后复制：=工作表（“处置”）在处置后添加模板表的副本
工作表（工作表（“处置”）.Index+1.Name=cell.value”重命名新添加的模板副本（在处置表之后为+1）
如果结束

非常感谢，它几乎完美无瑕！但是，如果我先创建两个新的Shreet，然后发现我需要一个额外的Shreet，因此在索引中添加一个xtra名称并再次运行vba，它会将新的xtra工作表命名为“template 2”。是否可以以某种方式解决此问题？要显示代码：

Sub CreateSheets（）Dim StartSheet As worket Set StartSheet=ActiveSheet Dim rng As Range Dim cell As Range On Error转到Error handling If MsgBox（“Opret ark baseret påløbenumre？”，vbYesNo+vbQuestion）=vbNo，然后如果Set rng=Range（“A2:a2000”），则退出Sub End对于rng中的每个单元格，如果单元格为“”，则为工作表（“模板”）。之后复制：=工作表（“处置”）工作表（工作表（“处置”）。索引+1）。名称=如果下一个单元格出错，则为单元格结束处理：开始工作表。激活结束子项

非常感谢，它几乎可以完美工作！但是，如果我先创建两个新的Shreet，然后发现我需要一个额外的Shreet，因此在索引中添加一个xtra名称并再次运行vba，它会将新的xtra工作表命名为“template 2”。是否可以以某种方式解决此问题？要显示代码：

Sub CreateSheets（）Dim StartSheet As worket Set StartSheet=ActiveSheet Dim rng As Range Dim cell As Range On Error转到Error handling If MsgBox（“Opret ark baseret påløbenumre？”，vbYesNo+vbQuestion）=vbNo，然后如果Set rng=Range（“A2:a2000”），则退出Sub End对于rng中的每个单元格，如果单元格为“”，则复制工作表（“模板”）。复制后：=工作表（“处置”）工作表（工作表（“处置”）。索引+1。名称=单元格结束，如果下一个单元格出错处理：开始工作表。激活结束子项

If cell <> "" Then
    Worksheets("Template").Copy After:=Worksheets("disposition") 'adds a copy of the template sheet after disposition
    Worksheets(Worksheets("disposition").Index + 1).Name = cell.value 'renames the new added template copy (which is +1 after disposition sheet)
End If