如何在Excel宏中实现数据追加至月度表末尾的动态列表

你的问题出在最后一行固定选择了Range("A1224").Select，导致每次都粘贴到固定位置。要实现自动追加到前一日数据的末尾，核心是动态定位月度工作表中数据区域的最后一行，然后从下一行开始粘贴。

先给你优化后的完整宏代码（去掉了冗余的Select操作，VBA里尽量避免这类操作，更高效稳定）：

Sub 复制追加到月度表()
    Dim 每日数据区域 As Range
    Dim 月度工作表 As Worksheet
    Dim 目标起始行 As Long
    
    ' 1. 定义要复制的每日数据区域（从A2开始，覆盖所有有效数据）
    Set 每日数据区域 = ThisWorkbook.ActiveSheet.Range("A2", _
        ThisWorkbook.ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Offset(0, _
        ThisWorkbook.ActiveSheet.Cells(2, Columns.Count).End(xlToLeft).Column - 1))
    
    ' 2. 定位到月度工作表（已打开则直接使用，未打开则打开文件）
    On Error Resume Next
    Set 月度工作表 = Workbooks("sheet.xlsx").Sheets(1) ' 假设月度表是sheet.xlsx的第一个工作表，可按需修改
    On Error GoTo 0
    If 月度工作表 Is Nothing Then
        Set 月度工作表 = Workbooks.Open("C:\你的文件实际路径\sheet.xlsx").Sheets(1) ' 替换为真实文件路径
    End If
    
    ' 3. 找到月度表A列最后非空行的下一行，作为粘贴起始位置
    目标起始行 = 月度工作表.Cells(Rows.Count, "A").End(xlUp).Row + 1
    
    ' 4. 复制数据到目标位置
    每日数据区域.Copy Destination:=月度工作表.Cells(目标起始行, "A")
    
    ' 可选：自动保存月度表
    ' 月度工作表.Parent.Save
End Sub

关键修改说明 #

• 动态获取每日数据：不再用Select逐步选中，而是通过Cells(Rows.Count, "A").End(xlUp)找到A列最后一行有效数据，Cells(2, Columns.Count).End(xlToLeft)找到第2行最后一列有效数据，直接组合成完整的待复制区域。
• 动态定位目标行：Cells(Rows.Count, "A").End(xlUp).Row + 1的逻辑是从A列最底部往上找最后一个非空单元格，行号加1就是新数据的起始粘贴行，确保每次都追加到末尾。
• 取消冗余操作：直接通过对象引用操作工作表和数据区域，避免因当前选中工作表变化导致的错误，同时提升运行效率。

注意事项 #

• 替换代码中的文件路径为你实际的月度文件路径，如果运行宏时该文件已打开，会直接使用已打开的文件。
• 如果月度表不是第一个工作表，把Sheets(1)改成实际的工作表名称，比如Sheets("月度汇总")。
• 若需要保留格式，可将Copy Destination:=...替换为：

  每日数据区域.Copy
  月度工作表.Cells(目标起始行, "A").PasteSpecial xlPasteAll
  Application.CutCopyMode = False
  

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