如何用VBA宏批量处理指定文件夹的Excel文件并迁移数据

下面是完整的VBA代码，直接替换你现有宏里的逻辑即可，包含迭代处理、文件移动和错误处理：

Sub BatchProcessFiles()
    ' 定义路径
    Dim sourceFolder As String
    Dim targetFile As String
    Dim processedFolder As String ' 处理后文件的存放路径
    Dim sourceFile As String
    
    ' 设置路径，根据实际情况修改
    sourceFolder = "D:\My Drive\EM SSC\PA\AttNew\"
    targetFile = "C:\Users\r5\Documents\DataFile_v1.xlsx"
    processedFolder = "D:\My Drive\EM SSC\PA\AttProcessed\" ' 可自定义
    
    ' 确保路径末尾有反斜杠
    If Right(sourceFolder, 1) <> "\" Then sourceFolder = sourceFolder & "\"
    If Right(processedFolder, 1) <> "\" Then processedFolder = processedFolder & "\"
    
    ' 自动创建已处理文件夹（如果不存在）
    If Dir(processedFolder, vbDirectory) = "" Then
        MkDir processedFolder
    End If
    
    ' 获取源文件夹中的第一个Excel文件（.xlsx格式，如需处理xls可修改后缀）
    sourceFile = Dir(sourceFolder & "*.xlsx")
    
    ' 打开目标文件，保持打开状态提升效率
    Dim targetWB As Workbook
    Set targetWB = Workbooks.Open(targetFile)
    
    ' 循环处理所有文件
    Do While sourceFile <> ""
        On Error Resume Next ' 单个文件出错不中断整体流程
        Dim sourceWB As Workbook
        Set sourceWB = Workbooks.Open(sourceFolder & sourceFile)
        
        ' --------------------------
        ' 这里替换成你已实现的单个文件复制逻辑
        ' 示例（参考）：复制源文件Sheet1的A1:C10到目标文件Sheet2的最后一行
        ' Dim lastRow As Long
        ' lastRow = targetWB.Sheets("Sheet2").Cells(Rows.Count, 1).End(xlUp).Row + 1
        ' sourceWB.Sheets("Sheet1").Range("A1:C10").Copy targetWB.Sheets("Sheet2").Cells(lastRow, 1)
        ' --------------------------
        
        ' 关闭源文件，无需保存
        sourceWB.Close SaveChanges:=False
        
        ' 将处理后的文件移动到已处理文件夹；如需删除则替换为 Kill sourceFolder & sourceFile
        Name sourceFolder & sourceFile As processedFolder & sourceFile
        
        ' 获取下一个文件
        sourceFile = Dir()
        
        On Error GoTo 0 ' 重置错误处理
    Loop
    
    ' 保存并关闭目标文件
    targetWB.Close SaveChanges:=True
    
    MsgBox "批量处理完成！"
End Sub

代码关键部分说明 #

• 路径配置：修改sourceFolder、targetFile、processedFolder为你的实际路径，代码会自动创建不存在的已处理文件夹。
• 迭代逻辑：用Dir函数遍历文件夹内的Excel文件，Do While循环实现逐个处理，直到文件夹内无符合条件的文件。
• 效率优化：提前打开目标文件，避免重复打开关闭操作，减少资源消耗。
• 容错处理：On Error Resume Next确保单个文件处理出错时，流程继续执行，不会直接崩溃。
• 文件清理：用Name语句移动文件，替换为Kill语句可直接删除处理后的文件。

使用注意事项 #

1. 确保源文件夹中的Excel文件格式完全一致，否则你的复制逻辑可能出错。
2. 运行宏前关闭所有打开的Excel文件（包括目标文件），避免文件占用冲突。
3. 测试时请先备份源文件，防止误操作导致数据丢失。

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