Excel VBA批量处理文件夹文件：优化重复代码与提速方案

Hey there! Let's break down how to solve your three key issues and turn your repetitive code into a clean, efficient solution.

1. Batch Process All Files in a Specified Folder #

Instead of hardcoding individual file paths, we can use the Dir function to loop through every Excel file in your target folder. This way, you don't have to update the code every time you add a new file.

How it works: #

• Define your source folder path (where all the "F3 S18..." files live)
• Use Dir to grab the first file, then loop until there are no more files left
• For each file, open it, process the data, then close it

2. Avoid Duplicate Code with a Reusable Subroutine #

Your current code repeats the same cell-copying logic three times. We'll extract this into a separate Sub that takes parameters (source worksheet, target worksheet, target row number) so you can call it over and over without rewriting the same lines. This follows the DRY (Don't Repeat Yourself) principle, making your code easier to maintain and debug.

3. Speed Up Your Code #

The slowdown is likely from repeated screen updates, opening/closing the target file multiple times, and Excel's automatic calculations. Here's how to fix it:

• Disable screen updating: Stops Excel from redrawing the screen while the code runs
• Turn off automatic calculation: Prevents Excel from recalculating every time you change a cell
• Disable events: Stops any worksheet/workbook events from triggering during execution
• Open the target file only once: No need to open/close it for every source file—open it at the start, process all data, then save and close it at the end

Refactored Full Code #

Here's the optimized code that addresses all three issues:

Sub BatchCopyCellData()
    ' Declare variables
    Dim sourceFolderPath As String
    Dim targetFilePath As String
    Dim sourceFileName As String
    Dim wbkSource As Workbook
    Dim wbkTarget As Workbook
    Dim wsSource As Worksheet
    Dim wsTarget As Worksheet
    Dim targetRow As Long
    
    ' Set your paths here (update these to match your actual folders)
    sourceFolderPath = "E:\2020\Informes de Tutoría\18 semana\"
    targetFilePath = "D:\Nueva carpeta\4 Ficha-directivos-Seguimiento-Tutoria-Semana 16.xls"
    
    ' Initialize target row (starts at 7 as per your original code)
    targetRow = 7
    
    ' Speed optimization settings
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.Calculation = xlCalculationManual
    
    On Error GoTo Cleanup ' Handle errors and restore settings no matter what
    
    ' Open target workbook ONCE (no need to re-open for every source file)
    Set wbkTarget = Workbooks.Open(targetFilePath)
    Set wsTarget = wbkTarget.Sheets("F3")
    
    ' Get first Excel file in the source folder
    sourceFileName = Dir(sourceFolderPath & "*.xls")
    
    ' Loop through all Excel files in the source folder
    Do While sourceFileName <> ""
        ' Open source workbook
        Set wbkSource = Workbooks.Open(sourceFolderPath & sourceFileName)
        Set wsSource = wbkSource.Sheets("F3")
        
        ' Call our reusable subroutine to handle the data copy
        CopyDataToTarget wsSource, wsTarget, targetRow
        
        ' Close source workbook without saving changes
        wbkSource.Close SaveChanges:=False
        
        ' Move to the next row in the target sheet
        targetRow = targetRow + 1
        
        ' Grab the next file in the folder
        sourceFileName = Dir
    Loop
    
    ' Save all changes to the target workbook
    wbkTarget.Save
    
Cleanup:
    ' Restore Excel's default settings
    Application.ScreenUpdating = True
    Application.EnableEvents = True
    Application.Calculation = xlCalculationAutomatic
    
    ' Close target workbook if it's still open
    If Not wbkTarget Is Nothing Then
        wbkTarget.Close SaveChanges:=False ' We already saved earlier, so no need to save again
    End If
    
    ' Release object variables to free memory
    Set wsSource = Nothing
    Set wbkSource = Nothing
    Set wsTarget = Nothing
    Set wbkTarget = Nothing
    
    ' Let the user know we're done
    MsgBox "Batch processing completed successfully!", vbInformation
End Sub

' Reusable subroutine to copy data from source sheet to target sheet at the specified row
Private Sub CopyDataToTarget(wsSource As Worksheet, wsTarget As Worksheet, targetRow As Long)
    With wsTarget
        .Range("G" & targetRow).Value = wsSource.Range("O34").Value
        .Range("M" & targetRow).Value = wsSource.Range("P34").Value
        .Range("Q" & targetRow).Value = wsSource.Range("T33").Value
        .Range("T" & targetRow).Value = wsSource.Range("U33").Value
        .Range("V" & targetRow).Value = wsSource.Range("W33").Value
        .Range("W" & targetRow).Value = wsSource.Range("X38").Value
        .Range("X" & targetRow).Value = wsSource.Range("Z38").Value
    End With
End Sub

Key Improvements Explained: #

• Batch Processing: The Dir loop automatically processes every .xls file in your source folder—no more hardcoding file names
• Reusable Code: The CopyDataToTarget sub handles all cell copying; if you need to adjust which cells are copied, you only change it once
• Speed: Disabled unnecessary Excel features during execution, opened the target file only once, and added error handling to ensure settings are always restored

内容的提问来源于stack exchange，提问作者Jh-kllup