复制工作表模板。 在列表中添加标题并重命名工作表

我正在尝试制作大量相同图纸模板的副本，其中表格名称和标题需要从列表中拉出。 我试过在下面说明我的愿望。

基本上我有这个模板在手动重命名工作表名称为1和标题是testing1：

我想这是以某种方式自动化，因为我有大约136张我需要复制和重命名，以及添加标题。

我在想的步骤是：复制工作表“1”，从Vejnavne列表中重新命名为“2”，添加标题testing2.重复，为3,4,5等。

现在名字不应该是testing1，2 …这些被审查，为什么我需要它也从列表中提取数据从Liste med vejnavne。 我已经偶然发现了这个代码片段来复制工作表，它说我将需要重新命名工作表，而不是“工作表1”，我想这一定是可以从名为“Liste med vejnavne” ，A3-A138栏。

Sub Copier() Dim x As Integer x = InputBox("Enter number of times to copy active sheet") For numtimes = 1 To x 'Loop by using x as the index number to make x number copies. ActiveWorkbook.ActiveSheet.Copy _ After:=ActiveWorkbook.Sheets("Sheet1") 'Put copies in front of Sheet1. 'Replace "Sheet1" with sheet name that you want. Next End Sub 

Answer 1

复制工作表后，新副本变为“活动”，因此您可以将所需的名称分配给该ActiveSheet并在单元格A1中设置值。

 Sub Copier() Dim x As Long Dim numtimes As Long Dim wsTemplate As Worksheet 'Set which sheet is the template Set wsTemplate = ActiveSheet x = InputBox("Enter number of times to copy active sheet") For numtimes = 1 To x wsTemplate.Copy After:=ActiveWorkbook.Sheets("Sheet1") ActiveSheet.Name = Worksheets("Liste med vejnavne").Cells(numtimes + 2, "A").Value ActiveSheet.Cells(1, "A").Value = Worksheets("Liste med vejnavne").Cells(numtimes + 2, "B").Value Next End Sub