如何在VBA中复制表格格式同时用计数器更新指定单元格命名工作表

你需要的计数器逻辑可以通过在模板工作表预留专门的计数单元格实现，结合原有代码修改后的完整实现如下：

Public Sub CopySheetAndRenameByCell()
    ' 定义变量：模板工作表、新工作表、计数器值
    Dim templateWks As Worksheet
    Dim newWks As Worksheet
    Dim counter As Long
    
    ' 绑定当前激活的工作表为模板表（也可以固定为指定名称的表，避免误操作其他表时触发）
    Set templateWks = ActiveSheet
    
    ' --------------- 配置区域：按需修改单元格地址 ----------------
    ' 读取模板表中存储计数器的单元格数值，示例用A1，可替换为你需要的任意单元格
    If IsNumeric(templateWks.Range("A1").Value) Then
        counter = CLng(templateWks.Range("A1").Value)
    Else
        ' 如果单元格为空/非数值，初始化计数器为1
        counter = 1
    End If
    ' 计数器+1
    counter = counter + 1
    ' 更新回模板表的计数单元格
    templateWks.Range("A1").Value = counter
    ' -----------------------------------------------------------
    
    ' 复制模板表到所有工作表末尾
    templateWks.Copy After:=Worksheets(Sheets.Count)
    Set newWks = ActiveSheet
    
    ' 命名新工作表，添加错误处理避免重名报错
    On Error Resume Next
    newWks.Name = CStr(counter)
    ' 如果出现重名，自动在后面加序号后缀
    If Err.Number <> 0 Then
        Dim suffix As Integer
        suffix = 1
        Do
            Err.Clear
            newWks.Name = CStr(counter) & "_" & suffix
            suffix = suffix + 1
        Loop Until Err.Number = 0
    End If
    On Error GoTo 0
    
    ' 切回模板工作表，方便下一次生成操作（修正原有代码的Active拼写错误，正确方法为Activate）
    templateWks.Activate
End Sub

• 新增计数器读写逻辑：默认从模板表的A1单元格读取计数，你可以把Range("A1")改成你需要的任意单元格地址，比如你之前用到的H9也可以
• 增加非数值/空值的兜底逻辑，首次运行时会自动初始化计数器为1
• 新增重名错误处理，避免出现相同工作表名时宏运行崩溃
• 修复了原代码中wks.Active的语法错误，正确的激活工作表方法为Activate

如果你不想把计数器存在可见单元格里避免被误改，可以使用Excel的名称管理器存储全局计数器，实现逻辑如下：

• 打开「公式」选项卡→「名称管理器」→「新建」，名称输入SheetCounter，值输入1，范围选工作簿
• 把代码中读写计数器的部分替换为如下内容即可：

' 读取计数器
counter = CLng(ThisWorkbook.Names("SheetCounter").RefersToRange.Value)
' 更新计数器
ThisWorkbook.Names("SheetCounter").RefersToRange.Value = counter + 1

内容的提问来源于stack exchange，提问作者Ipixler