如何用VBA实现跨工作簿导入数据到下一空行并匹配单元格位置

核心功能匹配 #

• 宏触发入口位于总览工作表（工作表B），运行后支持用户手动输入源工作簿（存放标准录入表/工作表A的文件）的完整路径
• 所有新导入的订单数据自动追加到工作表B的最后一个空行，不会覆盖已有历史订单记录
• 单元格映射规则支持自定义配置，无需修改核心导入逻辑即可调整源表、目标表的字段对应关系

完整可运行VBA代码 #

Sub 导入销售订单数据()
    Dim wsTarget As Worksheet
    Dim wbSource As Workbook
    Dim wsSource As Worksheet
    Dim sourcePath As String
    Dim nextRow As Long
    Dim mapRule As Variant
    Dim i As Long
    
    ' 配置区：按需修改以下参数即可
    Const SOURCE_SHEET_NAME As String = "工作表A" ' 源录入表的名称
    Const TARGET_SHEET_NAME As String = "工作表B" ' 目标总览表的名称
    ' 映射规则：每一行格式为 Array("工作表A的单元格地址", 工作表B对应的列号)
    ' 示例：工作表A的A3单元格（销售价格）写入工作表B的B列，可自行增删规则
    mapRule = Array( _
        Array("A3", 2), _
        Array("A2", 1), _
        Array("B5", 3) _
    )
    ' 配置区结束
    
    ' 关闭屏幕更新提升运行速度
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    
    On Error GoTo ErrorHandler
    
    ' 绑定目标工作表
    Set wsTarget = ThisWorkbook.Worksheets(TARGET_SHEET_NAME)
    ' 获取目标表下一空行号
    nextRow = wsTarget.Cells(wsTarget.Rows.Count, 1).End(xlUp).Row + 1
    
    ' 弹出输入框获取源文件路径
    sourcePath = InputBox("请输入工作表A所在工作簿的完整文件路径：", "导入源路径选择")
    If sourcePath = "" Then
        MsgBox "未输入文件路径，导入已取消", vbInformation
        GoTo CleanUp
    End If
    ' 校验文件是否存在
    If Dir(sourcePath) = "" Then
        MsgBox "输入的路径不存在，请检查后重试", vbExclamation
        GoTo CleanUp
    End If
    
    ' 打开源工作簿
    Set wbSource = Workbooks.Open(Filename:=sourcePath, ReadOnly:=True)
    ' 绑定源工作表
    On Error Resume Next
    Set wsSource = wbSource.Worksheets(SOURCE_SHEET_NAME)
    On Error GoTo ErrorHandler
    If wsSource Is Nothing Then
        MsgBox "源工作簿中未找到名为【" & SOURCE_SHEET_NAME & "】的工作表，请检查", vbExclamation
        GoTo CleanUp
    End If
    
    ' 按照映射规则逐字段写入数据
    For i = LBound(mapRule) To UBound(mapRule)
        wsTarget.Cells(nextRow, mapRule(i)(1)).Value = wsSource.Range(mapRule(i)(0)).Value
    Next i
    
    MsgBox "订单数据导入完成，共写入第" & nextRow & "行", vbInformation

CleanUp:
    ' 关闭源工作簿，不保存
    If Not wbSource Is Nothing Then
        wbSource.Close SaveChanges:=False
    End If
    ' 恢复Excel设置
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    Exit Sub

ErrorHandler:
    MsgBox "导入出错，错误信息：" & Err.Description, vbCritical
    Resume CleanUp
End Sub

使用说明 #

• 打开存放工作表B（总览表）的工作簿，按Alt+F11唤起VBA编辑器，在当前工程面板右键插入新模块，将上述代码粘贴到模块中
• 先修改代码开头配置区的参数：将源表、目标表名称改成你实际的工作表名称，再按照你的字段对应关系调整mapRule里的映射项即可
• 可在工作表B页面插入形状按钮，将本宏指定给按钮，后续点击按钮即可触发导入
• 导入前请确保待导入的源工作簿处于关闭状态，避免文件占用导致读取失败
• 导入时在弹出的输入框中填入源工作簿的完整本地路径（例如D:\销售数据\202405订单012.xlsx），确认后即可自动完成追加写入

内容的提问来源于stack exchange，提问作者Jord de Keijzer