同一工作簿动态复制工作表数据时遇VBA运行时错误'5'求助

错误原因分析 #

原代码存在几个核心问题触发错误：

• 无效的单元格引用格式：ActiveSheet.Cells("A" & lastRowAll).Select中，Cells方法要求参数为(行号, 列号/列名)，直接传入"A2"这类字符串会触发"无效过程调用或参数"错误。
• 不稳定的边界获取逻辑：用Range("A1").End(xlDown).Row取最后一行时，若A1下方无数据会直接跳到工作表末尾，导致后续引用错误单元格；列的获取逻辑也存在同样问题。
• 未覆盖完整数据区域：原代码仅复制S1工作表的最后一个单元格，未实现动态数据全量复制的需求。
• 冗余的激活/选择操作：依赖Activate和Select会增加代码不稳定性，易因当前活动表变化引发错误。

修正后的代码 #

以下是修复问题并满足需求的代码，可动态获取S1的所有数据并追加到All工作表：

Sub consolidate()
    Dim wb As Workbook
    Dim wsAll As Worksheet
    Dim ws1 As Worksheet
    Dim lastRowAll As Long
    Dim lastRow1 As Long
    Dim lastCol1 As Long
    
    Set wb = ThisWorkbook
    Set wsAll = wb.Worksheets("All")
    Set ws1 = wb.Worksheets("S1")
    
    ' 获取All表的下一个空行（基于A列判断）
    lastRowAll = wsAll.Cells(wsAll.Rows.Count, "A").End(xlUp).Row + 1
    ' 安全获取S1表的最后一行和最后一列
    lastRow1 = ws1.Cells(ws1.Rows.Count, "A").End(xlUp).Row
    lastCol1 = ws1.Cells(1, ws1.Columns.Count).End(xlToLeft).Column
    
    ' 仅当S1存在数据时执行复制
    If lastRow1 >= 1 And lastCol1 >= 1 Then
        ' 复制S1的完整数据区域（从A1到最后一行最后一列）
        ws1.Range(ws1.Cells(1, 1), ws1.Cells(lastRow1, lastCol1)).Copy
        ' 粘贴到All表的下一个空行起始位置
        wsAll.Cells(lastRowAll, 1).PasteSpecial Paste:=xlPasteValuesAndNumberFormats
        ' 清除剪切板状态
        Application.CutCopyMode = False
    End If
    
    MsgBox "Job Complete!!"
End Sub

关键优化点 #

• 安全获取数据边界：改用Cells(Rows.Count, "A").End(xlUp).Row获取最后一行，即使仅存在表头也能正确定位；列的获取同理采用反向定位逻辑。
• 直接操作工作表对象：取消Activate和Select操作，直接通过工作表对象引用单元格，避免因活动表变化引发的错误。
• 全量复制动态数据：复制从A1到最后一行最后一列的完整数据区域，满足每日新增数据的复制需求。
• 增加数据有效性判断：避免S1表为空时执行无效的复制操作。

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