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

VBA如何遍历文件夹文件提取指定范围数据合并到Excel主工作簿

批量合并文件夹内Excel文件数据的VBA实现

完整修正代码

Sub 合并文件夹内数据到主表()
    ' 声明变量
    Dim oFSO As Object
    Dim oFolder As Object
    Dim oFile As Object
    Dim 主工作簿 As Workbook
    Dim 源工作簿 As Workbook
    Dim 数据源表 As Worksheet
    Dim 主数据表 As Worksheet
    Dim 源表最后行 As Long
    Dim 主表最后行 As Long
    Dim 文件夹路径 As String
    
    ' 配置参数,此处可根据实际情况修改
    文件夹路径 = "C:\Users\user name\Downloads\Test Consolidate Folder" ' 待合并文件所在文件夹
    Set 主工作簿 = ThisWorkbook ' 如主工作簿不是当前运行代码的工作簿,可修改为 Workbooks("Consolidate.xlsx")
    Set 主数据表 = 主工作簿.Worksheets("汇总") ' 主工作簿中存放合并数据的工作表名,可自行修改
    
    ' 关闭屏幕更新和警告,提升运行速度
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    
    Set oFSO = CreateObject("Scripting.FileSystemObject")
    Set oFolder = oFSO.GetFolder(文件夹路径)
    
    ' 遍历文件夹内所有文件
    For Each oFile In oFolder.Files
        ' 仅处理Excel文件,可根据需要补充后缀
        If oFile.Name Like "*.xls*" And oFile.Name <> 主工作簿.Name Then
            ' 打开源文件
            Set 源工作簿 = Workbooks.Open(oFile.Path)
            Set 数据源表 = 源工作簿.Worksheets("Parts") ' 源文件中取数的工作表名,根据实际修改
            
            ' 计算源表N列的最后一行,减去2行跳过末尾无效数据
            源表最后行 = 数据源表.Cells(Rows.Count, "N").End(xlUp).Row
            ' 只要源表有效行数大于等于10才执行复制,避免空数据报错
            If 源表最后行 >= 12 Then ' 10 + 2,保证减去2行后起始行不小于10
                ' 计算主表当前最后一行的下一行,用于追加粘贴
                主表最后行 = 主数据表.Cells(Rows.Count, "A").End(xlUp).Row + 1
                
                ' 直接赋值比复制粘贴效率更高,如需要保留格式可调整粘贴参数
                数据源表.Range("A10:N" & (源表最后行 - 2)).Copy 主数据表.Range("A" & 主表最后行)
            End If
            
            ' 关闭源文件,不保存
            源工作簿.Close SaveChanges:=False
        End If
    Next oFile
    
    ' 恢复系统设置
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    
    MsgBox "数据合并完成!"
End Sub

关键调整说明

  • 补全了文件打开、循环处理每个文件、关闭源文件的完整逻辑,修复了原代码没有遍历处理每个文件的问题
  • 修正了最后一行的计算逻辑:原代码错误使用文件名列表的行数作为数据源行数,改为读取源文件N列的实际最后一行再减2
  • 增加了主表追加位置的计算逻辑,每次新数据会自动粘贴到已有数据的下一行
  • 增加了Excel文件过滤、空数据判断的逻辑,避免处理非Excel文件和空表时报错
  • 优化了运行效率,增加了关闭屏幕更新和警告的设置,运行结束后自动恢复
  • 所有可修改的参数都做了标注,可根据实际使用场景调整路径、工作表名等配置

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

相关产品推荐
方舟 Agent Plan

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

最近更新时间:2026.09.26 03:24:03