复制作品sheet 模板。在 sheet 中添加标题并重命名 sheet，均来自列表

Question

我正在尝试制作同一个 sheet 模板的大量副本，其中 sheet 名称和标题需要从列表中提取。我已经尝试在下面说明我的愿望。

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

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

我想的步骤是：复制 Sheet“1”，将新的 sheet 从 Vejnavne 列表重命名为“2”，添加标题测试 2。重复 3 , 4, 5. 等等

现在这些名字不应该是测试 1、2...。这些是经过审查的，为什么我也需要它从 Liste med vejnavne 的列表中提取数据。我偶然发现了这个用于复制 sheets 的代码片段，它说我需要重命名 sheets 而不是 "Sheet 1"，我认为必须可以将sheet 来自我的 sheet 的名字叫 "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

复制 sheet 后，新副本变为 "active"，因此您可以为 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

复制作品sheet 模板。在 sheet 中添加标题并重命名 sheet，均来自列表

Copy worksheet template. Add headline in sheet and rename sheet, both from list

excel

vba

reference

copy-paste