复制工作表至新工作簿时出现日期异常的技术求助

问题原因 #

你遇到的是Excel日期系统不匹配导致的：Excel有两种日期计算系统——1900系统（Windows默认，起始日期1900/1/1）和1904系统（旧版Mac默认，起始日期1904/1/2），两者的日期数值差了1461天。你的源工作簿用的是1900系统（数值43465对应2023/1/1），但新生成的工作簿默认用了1904系统，43465减去1461就是42004，对应2018/12/31，所以显示异常，但底层数值是对的。

解决方法 #

方法1：统一新工作簿的日期系统 #

在创建新工作簿后，强制设置其使用1900日期系统，和源工作簿保持一致：

Sub CopySheetFixDate()
    Dim Newwb As Workbook
    ' 复制模板工作表到新工作簿
    Worksheets("Week Template").Copy
    Set Newwb = ActiveWorkbook
    ' 强制设置新工作簿为1900日期系统（和源工作簿一致）
    Newwb.Date1904 = False
    
    ' 直接复制值，无需激活/选择工作表和单元格
    ThisWorkbook.Worksheets("Week Template").Range("B3:B13").Copy
    Newwb.Worksheets("Week Template").Range("B3").PasteSpecial Paste:=xlPasteValues
    Application.CutCopyMode = False
End Sub

方法2：复制值的同时保留格式 #

如果需要保留原单元格的日期格式，可以把粘贴方式改成xlPasteValuesAndNumberFormats，这样既复制数值，又同步格式，避免显示混乱：

Sub CopySheetWithFormat()
    Dim Newwb As Workbook
    Worksheets("Week Template").Copy
    Set Newwb = ActiveWorkbook
    
    ThisWorkbook.Worksheets("Week Template").Range("B3:B13").Copy
    ' 同时粘贴值和数字格式
    Newwb.Worksheets("Week Template").Range("B3").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
    Application.CutCopyMode = False
End Sub

额外优化：避免使用Select/Activate #

原代码里的Select和Activate是VBA的低效写法，容易触发错误，上面的修正代码直接通过工作表和对象引用操作，更稳定高效。

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