通过VBA宏复制工作表数组并自动重编号新增周工作表

云上老周

2026-5-15

嘿，我来帮你搞定这个自动新增周工作表的宏！你的需求很明确——每次执行宏都要复制上一周的整套工作表（Week+周一到周日），自动把序号改成下一个，还要确保新表和汇总表关联。先说说你现有代码的小问题：数组引用重复了，而且完全没处理自动递增序号和重命名的逻辑，这就导致复制出来的表还是带(2)的后缀，没法自动变成Week 2、Monday 2这类名字。

下面给你一个完整的修正版宏，完全满足你的需求：

完整可运行的宏代码

Sub AddNewWeekSheets()
    Dim ws As Worksheet
    Dim maxWeekNum As Integer
    Dim newWeekNum As Integer
    Dim sheetNames As Variant
    Dim copiedSheets As Sheets
    Dim i As Integer
    
    ' 1. 自动识别当前工作簿里的最大周数
    maxWeekNum = 0
    For Each ws In ThisWorkbook.Sheets
        ' 只处理以"Week"开头的工作表
        If Left(ws.Name, 4) = "Week" Then
            ' 提取名称里的数字部分
            Dim weekNum As Integer
            weekNum = Val(Mid(ws.Name, 6))
            If weekNum > maxWeekNum Then
                maxWeekNum = weekNum
            End If
        End If
    Next ws
    newWeekNum = maxWeekNum + 1 ' 计算下一周的序号
    
    ' 2. 定义要复制的上一周工作表数组
    sheetNames = Array( _
        "Week " & maxWeekNum, _
        "Monday " & maxWeekNum, _
        "Tuesday " & maxWeekNum, _
        "Wednesday " & maxWeekNum, _
        "Thursday " & maxWeekNum, _
        "Friday " & maxWeekNum, _
        "Saturday " & maxWeekNum, _
        "Sunday " & maxWeekNum _
    )
    
    ' 3. 把整套工作表复制到工作簿最后
    Set copiedSheets = ThisWorkbook.Sheets(sheetNames).Copy(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
    
    ' 4. 批量重命名复制后的工作表
    For i = 1 To copiedSheets.Count
        Dim oldName As String
        oldName = copiedSheets(i).Name
        ' 去掉复制后的"(2)"后缀，替换成新周数
        Dim newName As String
        newName = Left(oldName, InStr(oldName, " (") - 1) & " " & newWeekNum
        copiedSheets(i).Name = newName
    Next i
    
    ' 5. 可选：更新新Week表中关联汇总表的公式（按需调整）
    ' 示例：如果原Week表有引用旧周数的公式，自动替换成新周数
    copiedSheets(1).Cells.Replace What:="Week " & maxWeekNum, Replacement:="Week " & newWeekNum, LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False
End Sub

关键逻辑说明

我把宏拆成了几个核心步骤，每一步都适配你的需求：

自动识别周数：遍历所有工作表，找出名字是"Week X"的最大X值，不管你之前执行过多少次宏，都能精准算出下一周的序号，完全不用手动改代码。
批量复制整套表：基于最大周数生成要复制的工作表数组，确保每次复制的都是最新的那一周的整套表。
自动重命名：把复制后带(2)后缀的名字，直接替换成新的周数，比如"Week 1 (2)"会变成"Week 2"，完美符合你的要求。
关联汇总表的适配：最后那段可选的替换代码，能自动把新Week表中引用旧周数的公式改成新周数，确保和汇总表的关联不会断。你可以根据自己的实际公式调整替换的内容（比如如果汇总表的引用是特定单元格，就修改What和Replacement的值）。

使用注意事项

确保你的原工作表命名严格是"Week 1"、"Monday 1"这种格式，数字前面必须有空格，不然提取周数的逻辑会出错。
第一次执行宏时，只要工作簿里有Week 1的整套表，宏会自动生成Week 2的整套表；第二次执行就生成Week 3，以此类推。
执行宏前建议先保存工作簿，避免意外情况导致数据丢失。

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