如何用Macro/VBA自动复制Excel周工作表并按前表生成正确日期？

下面是现成的VBA代码，可自动复制你的第1周工作表，生成2024年剩余51周的工作表，每个后续工作表的日期会自动引用前一张表对应单元格并加7天：

Sub GenerateWeeklySheets()
    Dim baseSheet As Worksheet
    Dim newSheet As Worksheet
    Dim i As Integer
    
    ' 设置基准工作表（第1周的表，若实际名称不是"Week 1"请修改）
    Set baseSheet = ThisWorkbook.Worksheets("Week 1")
    
    ' 生成第2到第52周的工作表
    For i = 2 To 52
        ' 复制基准工作表到工作簿末尾
        baseSheet.Copy After:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count)
        Set newSheet = ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count)
        ' 重命名新工作表
        newSheet.Name = "Week " & i
        
        ' 更新日期公式：引用前一张工作表的对应单元格并加7天
        ' 以下单元格范围按你的日程表实际位置修改（示例为周一B4、周二C4…周五F4）
        newSheet.Range("B4").Formula = "='" & ThisWorkbook.Worksheets(i - 1).Name & "'!B4 + 7"
        newSheet.Range("C4").Formula = "='" & ThisWorkbook.Worksheets(i - 1).Name & "'!C4 + 7"
        newSheet.Range("D4").Formula = "='" & ThisWorkbook.Worksheets(i - 1).Name & "'!D4 + 7"
        newSheet.Range("E4").Formula = "='" & ThisWorkbook.Worksheets(i - 1).Name & "'!E4 + 7"
        newSheet.Range("F4").Formula = "='" & ThisWorkbook.Worksheets(i - 1).Name & "'!F4 + 7"
        
        ' 若有其他需更新的日期单元格，继续添加类似行即可
    Next i
End Sub

使用步骤 #

• 打开你的Excel文件，确认第1周工作表的名称，将代码中"Week 1"替换为实际名称。
• 按Alt + F11打开VBA编辑器，右键点击左侧工作簿名称，选择「插入」→「模块」。
• 将上述代码粘贴到模块窗口，根据你的日程表调整日期所在的单元格范围。
• 按F5运行代码，或点击编辑器工具栏的运行按钮，等待生成全部52周工作表。

注意事项 #

• 确保第1周工作表的起始日期准确（如2024年第1周周一为1月1日）。
• 若运行时提示重命名错误，检查工作簿内是否已有同名工作表，删除后再重新运行。

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