如何将指定日期行按特定列序复制到另一工作簿工作表

核心思路 #

1. 先定义Orig表列与New表列的映射关系（需根据你的实际列序需求修改）
2. 高效筛选出Orig表中D列等于F1今日日期的行
3. 定位New表的最后一行，按指定列序将筛选出的数据追加过去

完整代码（替换你原有的SelectTodayRows宏） #

Sub CopyTodayRowsToDestination()
    Dim wsOrig As Worksheet, wsNew As Worksheet
    Dim todayDate As Date
    Dim lastRowOrig As Long, lastRowNew As Long
    Dim i As Long, j As Long
    ' 定义列映射：Orig表列标识 → New表列标识（根据实际需求修改）
    Dim colMap As Variant
    colMap = Array( _
        Array("A", "C"), _
        Array("B", "A"), _
        Array("D", "B"), _
        Array("E", "D") _
    )
    
    ' 初始化工作表对象
    Set wsOrig = ThisWorkbook.Worksheets("Orig")
    ' 若Destination.xlsm未打开，取消下面注释并填写正确路径
    ' Workbooks.Open "C:\YourFilePath\Destination.xlsm"
    Set wsNew = Workbooks("Destination.xlsm").Worksheets("New")
    
    ' 获取今日日期（取F1单元格的日期值，不受显示格式影响）
    todayDate = wsOrig.Range("F1").Value
    
    ' 获取Orig表D列的最后有效行，避免遍历冗余空行
    lastRowOrig = wsOrig.Cells(wsOrig.Rows.Count, "D").End(xlUp).Row
    
    ' 获取New表的最后一行，用于追加新数据
    lastRowNew = wsNew.Cells(wsNew.Rows.Count, 1).End(xlUp).Row + 1
    
    ' 遍历Orig表，筛选符合日期条件的行
    For i = 2 To lastRowOrig ' 假设第1行是表头，从第2行开始遍历；无表头则改为i=1
        If wsOrig.Cells(i, "D").Value = todayDate Then
            ' 按列映射规则复制数据到New表
            For j = LBound(colMap) To UBound(colMap)
                wsNew.Cells(lastRowNew, Columns(colMap(j)(1)).Column).Value = _
                    wsOrig.Cells(i, Columns(colMap(j)(0)).Column).Value
            Next j
            lastRowNew = lastRowNew + 1 ' 准备下一行追加
        End If
    Next i
    
    ' 释放对象
    Set wsOrig = Nothing
    Set wsNew = Nothing
    MsgBox "数据已成功追加到Destination.xlsm的New工作表！"
End Sub

关键调整说明 #

• 列映射自定义：修改colMap数组，把前一个元素换成Orig表的实际列名（如"A"、"B"），后一个元素换成New表对应的目标列名，确保顺序符合你的要求。
• 高效遍历：不再用字符串拼接行号的方式，而是直接遍历有效数据行，避免处理大量空行。
• 日期值匹配：直接用Value属性比较日期，不受单元格显示格式（dd mmm yy）影响，避免文本匹配错误。
• 自动定位追加行：用End(xlUp)精准找到New表的最后一行，不会覆盖已有数据。

注意事项 #

1. 确保Destination.xlsm处于打开状态，或者取消代码中Workbooks.Open的注释并填写正确文件路径。
2. 若需要复制单元格格式，可把.Value替换为.Copy，并添加wsNew.Cells(lastRowNew, Columns(colMap(j)(1)).Column).PasteSpecial xlPasteFormats（需调整代码逻辑）。

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