求VBA循环导入可变文件名文件的代码：支持编号与Amend文件处理

我来帮你改造这段代码，让它自动搜索符合规则的文件，不用再硬编码文件名啦！先明确下你的核心需求：

• 在指定目录中搜索文件名以「File_」开头的.xls文件，可变部分为数字（如File_1.xls、File_2.xls等）或「Amend」（即File_Amend.xls）
• 将所有数字编号文件的数据去除表头后，堆叠到同一工作表中
• 若存在File_Amend.xls文件，则将该文件的数据复制到独立工作表

你当前的硬编码代码： #

Sub SaveFile()

Dim wb As Workbook: Set wb = ThisWorkbook
Dim ws As Worksheet
Dim File As String
Dim wsCopy As Worksheet
Dim wsCopy2 As Worksheet
Dim wsCopy3 As Worksheet
Dim wsPaste As Worksheet

' For this part I am looking to have the file name constant as "File_" and then have the code search for files with the numbers 1,2,3,4, etc. instead of hardcoding in the file name 

File = "L:\Main\Code\"

Set wsCopy = File & wb.Sheets("Main").Range("C6") 'this value is "File 1.xls"
Workbooks.Open Filename:=wsCopy, ReadOnly:=True

Set wsCopy2 = File & wb.Sheets("Main").Range("C7") 'this value is "File 2.xls"
Workbooks.Open Filename:=wsCopy2, ReadOnly:=True

Set wsCopy3 = File & wb.Sheets("Main").Range ("C8") 'this value is "File Amend.xls"
Workbooks.Open Filename:=wsCopy3, ReadOnly:=True

Set wb = Workbooks.Add
Set wsPaste = wb.Sheets(1)

If Dir(wsCopy) = True Then
wsCopy.Range ("A:I").Copy
wsPaste.Cells.PasteSpecial Paste:=xlPasteValues

If Dir(wsCopy2) = True Then
wsCopy2.UsedRange.Offset(1,0).SpecialCells(xlCellTypeVisible).Copy
wsPaste.Cells (Rows.Count, "A").End(x1Up).Offset (1, 0).PasteSpecial Paste: xlPasteValues

If Dir(wsCopy3) = True Then
wsPaste.Cells.ClearContents
wsCopy3.Range("A:I").Copy
wsPaste.Range("Al").PasteSpecial Paste:=xlPasteValues

End Sub

改造后的代码（自动搜索+实现需求）： #

Sub ProcessFiles()
    Dim targetPath As String
    Dim currentFile As String
    Dim sourceWB As Workbook
    Dim destWB As Workbook
    Dim dataWS As Worksheet
    Dim amendWS As Worksheet
    Dim lastRow As Long
    
    ' 指定目标目录，可根据实际路径修改
    targetPath = "L:\Main\Code\"
    ' 确保目录路径以反斜杠结尾，避免拼接错误
    If Right(targetPath, 1) <> "\" Then targetPath = targetPath & "\"
    
    ' 创建新工作簿存放最终结果
    Set destWB = Workbooks.Add
    ' 用于存放数字编号文件的合并数据
    Set dataWS = destWB.Sheets(1)
    dataWS.Name = "CombinedData"
    
    ' 遍历所有符合规则的xls文件
    currentFile = Dir(targetPath & "File_*.xls")
    
    Do While currentFile <> ""
        ' 区分数字编号文件和Amend文件
        Select Case True
            ' 处理数字编号的文件（File_1.xls、File_2.xls等）
            Case IsNumeric(Mid(currentFile, 6, Len(currentFile) - 9))
                Set sourceWB = Workbooks.Open(Filename:=targetPath & currentFile, ReadOnly:=True)
                With sourceWB.Sheets(1) ' 假设数据在第一个工作表，可根据实际调整
                    ' 找到目标表的最后一行，确定粘贴位置
                    lastRow = dataWS.Cells(dataWS.Rows.Count, "A").End(xlUp).Row
                    If lastRow = 1 And dataWS.Range("A1") = "" Then
                        ' 若目标表为空，先复制表头（不需要表头可删除此段）
                        .Range("A:I").Copy
                        dataWS.Range("A1").PasteSpecial Paste:=xlPasteValues
                    Else
                        ' 复制除表头外的数据行
                        .UsedRange.Offset(1, 0).SpecialCells(xlCellTypeVisible).Copy
                        dataWS.Cells(lastRow + 1, "A").PasteSpecial Paste:=xlPasteValues
                    End If
                End With
                sourceWB.Close SaveChanges:=False
                
            ' 处理File_Amend.xls文件
            Case currentFile = "File_Amend.xls"
                ' 检查是否已存在Amend工作表，不存在则新建
                On Error Resume Next
                Set amendWS = destWB.Sheets("AmendData")
                On Error GoTo 0
                If amendWS Is Nothing Then
                    Set amendWS = destWB.Sheets.Add(After:=destWB.Sheets(destWB.Sheets.Count))
                    amendWS.Name = "AmendData"
                End If
                
                Set sourceWB = Workbooks.Open(Filename:=targetPath & currentFile, ReadOnly:=True)
                sourceWB.Sheets(1).Range("A:I").Copy
                amendWS.Range("A1").PasteSpecial Paste:=xlPasteValues
                sourceWB.Close SaveChanges:=False
        End Select
        
        ' 继续搜索下一个符合规则的文件
        currentFile = Dir
    Loop
    
    ' 清除剪贴板，避免内存占用
    Application.CutCopyMode = False
    MsgBox "数据处理完成！", vbInformation
End Sub

核心功能说明： #

• 自动搜索文件：用Dir(targetPath & "File_*.xls")遍历目录下所有符合开头规则的xls文件，彻底摆脱硬编码
• 智能区分文件类型：通过IsNumeric判断文件名的可变部分是否为数字，精准区分数字编号文件和Amend文件
• 自动合并数据：数字编号文件的数据会自动跳过表头，堆叠到CombinedData工作表，空表时可选择保留表头
• 独立处理Amend文件：如果存在File_Amend.xls，会自动创建AmendData独立工作表存放其数据
• 资源优化：所有源文件以只读模式打开，处理完成后立即关闭，避免占用系统资源

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