复制工作表模板。从列表中添加工作表和重命名工作表中的标题

Question

我试图制作相同工作表模板的大量副本，其中需要从列表中提取工作表名称和标题。我已尝试在下面说明我的意愿。

基本上我有这个模板，我手动将工作表名称重命名为1，标题是测试1：

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

我正在考虑的步骤是：复制表＆＃34; 1＆＃34;，将新表从Vejnavne列表重命名为＆＃34; 2＆＃34;，添加标题测试2.重复，适用于3,4,5等。

现在名称不应该是测试1,2 ......这些都是审查的，为什么我需要它也从Liste med vejnavne中的列表中提取数据。我偶然发现了这个代码片段来复制工作表，它说我需要重命名工作表而不是＆＃34;工作表1＆＃34;我认为必须能够提取工作表名称来自我的名为＆＃34; Liste med vejnavne＆＃34;，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