如何复制Excel表格可变行数的数据（排除表头）？现有VBA代码无效

问题描述 #

需要将一个工作簿中表格的数据复制到另一个工作簿：表头固定在第1行，待复制的数据从第2行开始，但数据行数不固定。尝试录制宏因行数可变失效，自行修改的查找最后非空行的VBA代码完全不起作用，原代码如下：

Dim ws As Worksheet, rng As Range
Set ws = ActiveSheet
Set rng = ws.Range("A2:EX" & ws.Cells(Rows.Count, "EX").End(xlUp).Row)

With ws.Cells(Rows.Count, "EX").End.Offset(-1)
    .Resize(rng.Rows.Count, rng.Columns.Count).Value = rng.Value 'copy values
End With

原代码问题分析 #

1. 逻辑偏离需求：原代码仅在当前工作表内复制数据，完全没涉及跨工作簿操作，自然达不到目的
2. 最后行判断不可靠：用EX列判断最后非空行，如果EX列无数据，ws.Cells(Rows.Count, "EX").End(xlUp).Row会返回1，导致A2:EX1这种无效的单元格范围
3. 复制目标位置错误：Offset(-1)的写法逻辑混乱，没有指向目标工作簿的对应位置

修正后的代码 #

以下是实现跨工作簿复制的VBA代码，每一步都加了注释说明：

Sub CopyDataToAnotherWorkbook()
    Dim sourceWs As Worksheet
    Dim targetWs As Worksheet
    Dim lastRow As Long
    Dim sourceRng As Range
    
    ' 1. 定义源工作表（替换成你实际的源工作表名称，比如"数据汇总"）
    Set sourceWs = ThisWorkbook.Worksheets("数据汇总")
    ' 2. 定义目标工作表（替换成你实际的目标工作簿路径和工作表名称）
    ' 若目标工作簿已打开，可直接写 Workbooks("目标文件.xlsx").Worksheets("接收表")
    Set targetWs = Workbooks.Open("C:\你的文件路径\目标工作簿.xlsx").Worksheets("接收表")
    
    ' 3. 找源数据的最后一行（用A列判断更可靠，因为A列是数据起始列，不会为空）
    lastRow = sourceWs.Cells(sourceWs.Rows.Count, "A").End(xlUp).Row
    
    ' 4. 确定要复制的范围：A2到EX列的最后一行
    Set sourceRng = sourceWs.Range("A2:EX" & lastRow)
    
    ' 5. 复制到目标工作表的下一个空行（若要覆盖目标表原有数据，可改成 targetWs.Range("A2")）
    sourceRng.Copy Destination:=targetWs.Cells(targetWs.Rows.Count, "A").End(xlUp).Offset(1)
    
    ' 可选：如果只需要复制值，不需要格式，用下面这行替换上面的Copy行
    ' targetWs.Cells(targetWs.Rows.Count, "A").End(xlUp).Offset(1).Resize(sourceRng.Rows.Count, sourceRng.Columns.Count).Value = sourceRng.Value
    
    ' 保存并关闭目标工作簿（如果是新打开的工作簿）
    targetWs.Parent.Save
    targetWs.Parent.Close
End Sub

注意事项 #

• 务必把代码中的源工作表名称、目标工作簿路径、目标工作表名称替换成你实际的信息
• 如果目标工作簿已经处于打开状态，删除Workbooks.Open部分，直接引用已打开的工作簿对象即可

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