You need to enable JavaScript to run this app.
优惠活动
大模型
产品
解决方案
定价
更多

VBA多Excel文件数据合并求助:提取指定行数据至目标文件

多Excel文件数据合并VBA解决方案

以下是修正后的完整代码,实现从多个选中的.xlsx文件提取第2行及以后的数据,合并后粘贴到目标文件的第2行(后续数据自动追加):

Sub MergeExcelData()
    Dim sourceFiles As Variant, destinationFile As Variant
    Dim sourceWB As Workbook, destWB As Workbook
    Dim sourceWS As Worksheet, destWS As Worksheet
    Dim lastRowSource As Long, lastColSource As Long
    Dim nextRowDest As Long
    Dim i As Integer
    
    ' 选择多个源文件
    sourceFiles = Application.GetOpenFilename(FileFilter:="Excel Files (*.xlsx), *.xlsx", MultiSelect:=True)
    If Not IsArray(sourceFiles) Then Exit Sub ' 用户取消选择时退出
    
    ' 选择目标文件
    destinationFile = Application.GetOpenFilename(FileFilter:="Excel Files (*.xlsx), *.xlsx", MultiSelect:=False)
    If destinationFile = False Then Exit Sub ' 用户取消选择时退出
    
    ' 打开目标文件并指定第一个工作表(可根据需求修改为指定工作表名)
    Set destWB = Workbooks.Open(destinationFile)
    Set destWS = destWB.Sheets(1)
    
    ' 循环处理每个源文件
    For i = LBound(sourceFiles) To UBound(sourceFiles)
        Set sourceWB = Workbooks.Open(sourceFiles(i))
        Set sourceWS = sourceWB.Sheets(1)
        
        ' 获取源文件数据的最后一行和最后一列(从第2行开始识别)
        lastRowSource = sourceWS.Cells(sourceWS.Rows.Count, 1).End(xlUp).Row
        lastColSource = sourceWS.Cells(2, sourceWS.Columns.Count).End(xlToLeft).Column
        
        ' 仅当源文件第2行及以后有数据时执行复制
        If lastRowSource >= 2 Then
            ' 计算目标文件的下一个粘贴行
            nextRowDest = destWS.Cells(destWS.Rows.Count, 1).End(xlUp).Row
            If nextRowDest < 2 Then
                nextRowDest = 2 ' 目标文件无数据时从第2行开始粘贴
            Else
                nextRowDest = nextRowDest + 1 ' 已有数据时追加到下一行
            End If
            
            ' 复制源文件数据并粘贴到目标文件
            sourceWS.Range(sourceWS.Cells(2, 1), sourceWS.Cells(lastRowSource, lastColSource)).Copy _
                destWS.Cells(nextRowDest, 1)
        End If
        
        ' 关闭源文件,不保存任何修改
        sourceWB.Close SaveChanges:=False
    Next i
    
    MsgBox "数据合并完成!"
End Sub

关键逻辑说明

  • 自动适配数据范围:通过End(xlUp)和End(xlToLeft)自动识别每个源文件的有效数据边界,无需提前固定行列数
  • 粘贴位置控制:确保首次粘贴从目标文件第2行开始,后续数据自动追加到现有数据的下一行,避免覆盖表头或已有内容
  • 源文件保护:处理完每个源文件后直接关闭且不保存,完全不修改原始文件
  • 异常处理:增加用户取消文件选择时的退出逻辑,防止代码报错

内容的提问来源于stack exchange,提问作者lucky_simFR

相关产品推荐
方舟 Agent Plan

超全模态模型 × Harness 升级,最新支持 Deepseek-V4.1-Flash、GLM-5.3 系列、Doubao-Seedream-5.0-pro、Kimi-K3 (部分), 限时 9.9 元起

最近更新时间:2026.08.07 17:50:34