如何使用VBA将日期从一个Excel工作簿复制到另一个工作簿

你遇到的序列号偏差值为1462，是两个工作簿启用了不同日期系统导致的：

• Windows版Excel默认使用1900日期系统，序列号1对应1900年1月1日
• Mac版Excel默认使用1904日期系统，序列号1对应1904年1月2日，两类系统的序列号固定差值为1462
  你的源工作簿使用1900日期系统，目标工作簿使用1904日期系统，因此2021年9月30日的序列号从43007被自动转换为43007+1462=44469。

方法1：统一工作簿日期系统（优先推荐） #

无需修改代码，直接调整目标工作簿配置即可：

1. 打开目标工作簿，依次点击「文件」-「选项」-「高级」
2. 找到「计算此工作簿时」分类，取消勾选「使用1904日期系统」
3. 保存配置后重新运行现有复制代码，日期序列号就会完全匹配。

方法2：修改VBA代码适配差值 #

如果你无法修改目标工作簿的日期配置，可以修改复制逻辑，使用Value2属性获取单元格原始存储值，避免Excel隐式转换，同时手动校正日期差值：

'----获取源数据工作簿的行列数
Dim wbRowCount As Integer
Dim wbColCount As Integer

wbRowCount = wb.Worksheets(1).UsedRange.Rows.Count
wbColCount = wb.Worksheets(1).UsedRange.Columns.Count

'----定义目标表参数
Dim startIndex As Integer
Dim numRows As Integer
Dim numCols As Integer
' 源为1900系统、目标为1904系统时固定差值为1462
Dim dateOffset As Long
dateOffset = 1462

startIndex = 0

For numRows = 1 To wbRowCount
    For numCols = 1 To wbColCount
        ' 用Value2取原始存储值，跳过隐式格式转换，日期类型自动校正差值
        If IsDate(wb.Worksheets(1).Cells(numRows, numCols)) Then
            Cells(numRows + startIndex, numCols) = wb.Worksheets(1).Cells(numRows, numCols).Value2 - dateOffset
        Else
            Cells(numRows + startIndex, numCols) = wb.Worksheets(1).Cells(numRows, numCols).Value2
        End If
    Next numCols
Next numRows

startIndex = numRows + 1
numRows = 0

你原有代码的问题是直接赋值单元格默认属性，会触发Excel根据目标表日期系统自动转换的逻辑，使用Value2可以直接读取单元格存储的原始序列号，避免这类非预期转换。

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