Excel宏跨工作簿数据追加：避免覆盖已有数据的实现方法

没问题，咱们直接修改你现有的Transfer宏就行，完全不需要新增模块。核心就是把你提到的「定位最后一行」的逻辑整合进去，替换掉原来固定的粘贴位置，这样新数据就会自动追加到已有数据的下方空白行。

修改后的完整代码 #

Sub Transfer()
    ' 直接复制源数据（避免用Select，更高效稳定）
    ThisWorkbook.Range("A2:G34").Copy
    
    ' 打开目标工作簿并赋值给变量，避免依赖ActiveWorkbook
    Dim targetWB As Workbook
    Set targetWB = Workbooks.Open(Filename:="Book1.xlsx")
    
    Dim lastRow As Long
    ' 定位目标工作表A列最后一个非空行的下一行
    ' 用Rows.Count代替固定数字，适配不同Excel版本的行上限
    lastRow = targetWB.Sheets(1).Range("A" & targetWB.Sheets(1).Rows.Count).End(xlUp).Row + 1
    
    ' 粘贴到目标空白行
    targetWB.Sheets(1).Range("A" & lastRow).PasteSpecial Paste:=xlPasteValuesAndNumberFormats, _
        Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    
    ' 清理剪贴板并保存关闭目标工作簿
    Application.CutCopyMode = False
    targetWB.Save
    targetWB.Close SaveChanges:=False ' 已经Save过，这里关闭时无需再保存
End Sub

关键修改点说明 #

• 去掉冗余的Select操作：原代码里的Select和Selection不仅运行效率低，还容易因窗口切换出错，直接操作单元格/工作簿对象更可靠。
• 精准定位最后一行：用Rows.Count代替你提到的固定10000，能适配所有Excel版本（比如新版Excel支持1048576行），确保不会漏掉数据；End(xlUp)会从列底向上找第一个非空单元格，+1就得到了下一个空白行的行号。
• 明确引用目标对象：用targetWB变量绑定打开的工作簿，后续操作都基于这个变量，避免因激活其他窗口导致的错误。

额外注意事项 #

• 如果你的目标数据不是在目标工作簿的第一个工作表，把targetWB.Sheets(1)改成具体的工作表名称，比如targetWB.Sheets("数据汇总")。
• 如果Book1.xlsx不在当前Excel的默认保存目录，最好写完整文件路径，比如"C:\工作文件夹\Book1.xlsx"，避免找不到文件。

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