求助：用VBA遍历指定XLSX文件并批量追加数据至目标文件

需求概述 #

需要遍历指定文件夹中名称包含"Infra Pvt Ltd"且扩展名为.xlsx的Excel文件，将每个文件中不含表头的数据追加到目标工作簿的最后一行下方。

原代码存在的问题 #

• Dir函数调用错误，未正确指定文件筛选规则
• Workbooks.Open语句语法不完整，路径拼接逻辑错误
• 缺少文件名匹配判断逻辑，无法筛选符合条件的文件
• 未实现数据复制与追加的核心逻辑
• 循环未更新File_path变量，会导致死循环

修正后的完整代码 #

Sub Append_Files()
    Dim xWb As Workbook
    Dim targetWs As Worksheet
    Dim sourceWs As Worksheet
    Dim fileDir As String
    Dim fileName As String
    Dim lastRowTarget As Long
    Dim lastRowSource As Long
    Dim matchText As String
    
    ' 配置参数
    fileDir = "C:\Users\XYZ\Documents\MixedFiles\" ' 目标文件夹路径
    matchText = "Infra Pvt Ltd" ' 需要匹配的文件名关键词
    Set targetWs = ThisWorkbook.Worksheets("目标工作表名称") ' 指定目标工作表，自行替换
    
    ' 遍历文件夹中的xlsx文件
    fileName = Dir(fileDir & "*.xlsx")
    Do While fileName <> ""
        ' 判断文件名是否包含指定关键词（不区分大小写）
        If InStr(1, LCase(fileName), LCase(matchText), vbTextCompare) > 0 Then
            ' 打开源文件
            Set xWb = Workbooks.Open(fileDir & fileName)
            Set sourceWs = xWb.Worksheets(1) ' 默认取第一个工作表，可根据需求修改
            
            ' 获取源数据最后一行（跳过表头，从第2行开始）
            lastRowSource = sourceWs.Cells(sourceWs.Rows.Count, "A").End(xlUp).Row
            If lastRowSource >= 2 Then ' 确保源文件有数据（除表头外）
                ' 获取目标工作表最后一行
                lastRowTarget = targetWs.Cells(targetWs.Rows.Count, "A").End(xlUp).Row
                If lastRowTarget = 1 And targetWs.Cells(1, "A").Value = "" Then
                    ' 如果目标表为空，从第1行开始粘贴（避免空行）
                    lastRowTarget = 0
                End If
                
                ' 复制源数据（从第2行到最后一行，所有列）并粘贴到目标表
                sourceWs.Range("A2:" & sourceWs.Cells(lastRowSource, sourceWs.Columns.Count).End(xlToLeft).Address).Copy _
                    targetWs.Cells(lastRowTarget + 1, "A")
            End If
            
            ' 关闭源文件，不保存更改
            xWb.Close SaveChanges:=False
        End If
        
        ' 获取下一个文件名
        fileName = Dir
    Loop
    
    MsgBox "数据追加完成！"
End Sub

关键说明 #

• 路径与工作表配置：请将targetWs中的"目标工作表名称"替换为你实际要追加数据的工作表名称
• 大小写兼容：使用LCase和vbTextCompare实现不区分大小写的文件名匹配，避免因大小写差异漏处理文件
• 数据范围处理：自动识别源文件的有效数据范围（从第2行开始），以及目标工作表的最后一行，确保数据正确追加
• 资源释放：打开的源文件会自动关闭且不保存，避免占用Excel进程

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