如何通过VBA将工作簿中当日数据复制到另一工作簿并按格式追加？

现有两个Excel工作簿：

• FIRST.xlsm：包含Sheet1工作表，数据格式如下（逗号分隔列）：

Name, Date, Cost
Y, 03 Nov 22, 100
X, 04 Nov 22, 1000
Z, 04 Nov 22, 10000000

• SECOND.xlsm：包含Sheet2工作表，原有数据格式如下（逗号分隔列）：

Leave blank, Date, Leave blank, Name
None, 03 Jan 18, None, A

需实现以下操作：

1. 从Sheet1中筛选出日期等于当日的数据行
2. 提取这些行的Date和Name字段
3. 按照Sheet2的格式（第1、3列填None，第2列填Date，第4列填Name），将筛选结果追加到Sheet2末尾
4. 最终Sheet2效果如下：

Leave blank, Date, Leave blank, Name
None, 03 Jan 18, None, A
None, 04 Nov 22, None, X
None, 04 Nov 22, None, Z

Public Sub CopyData()
    Dim dataWb As Workbook ' 源工作簿：FIRST.xlsm（包含Sheet1）
    Dim destWb As Workbook ' 目标工作簿：SECOND.xlsm（包含Sheet2）
    Dim dataWs As Worksheet
    Dim destWs As Worksheet
    Dim lastRow As Long
    Dim i As Long
    Dim currentDate As Date
    
    ' 绑定目标工作簿和工作表
    Set destWb = ThisWorkbook
    Set destWs = destWb.Worksheets("Sheet2")
    
    ' 打开源工作簿（请替换为实际完整路径）
    Set dataWb = Workbooks.Open("S:\实际路径\FIRST.xlsm")
    Set dataWs = dataWb.Worksheets("Sheet1")
    
    ' 获取当日日期（仅保留日期部分，忽略时间）
    currentDate = Date
    
    ' 获取Sheet1数据区域的最后一行行号
    lastRow = dataWs.Cells(dataWs.Rows.Count, "B").End(xlUp).Row
    
    ' 遍历Sheet1数据（从第2行开始，跳过表头）
    For i = 2 To lastRow
        ' 匹配当日日期（需确保Sheet1的B列为日期格式）
        If Int(dataWs.Cells(i, "B").Value) = currentDate Then
            ' 获取Sheet2的下一个空行
            Dim destLastRow As Long
            destLastRow = destWs.Cells(destWs.Rows.Count, "B").End(xlUp).Row + 1
            
            ' 按格式写入数据
            destWs.Cells(destLastRow, "A").Value = "None"
            destWs.Cells(destLastRow, "B").Value = dataWs.Cells(i, "B").Value
            destWs.Cells(destLastRow, "C").Value = "None"
            destWs.Cells(destLastRow, "D").Value = dataWs.Cells(i, "A").Value
        End If
    Next i
    
    ' 关闭源工作簿，不保存修改
    dataWb.Close SaveChanges:=False
    
    MsgBox "数据追加完成！", vbInformation
End Sub

• 路径替换：必须将代码中的"S:\实际路径\FIRST.xlsm"替换为FIRST工作簿的真实完整路径
• 日期格式校验：确保Sheet1的B列是标准日期格式，否则日期匹配会失效；用Int()提取日期整数部分是为了避免时间戳干扰
• 追加逻辑：每次找到符合条件的行，自动定位Sheet2的下一个空行，避免覆盖原有数据
• 源文件保护：使用SaveChanges:=False确保源工作簿不会被意外修改，若需保存源文件修改可改为True

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