如何从多工作簿提取指定工作表并合并？求VBA代码修正

Got it, let's fix that VBA code to correctly extract only the Math Result sheets from each of your class workbooks and merge them into a single master sheet. The issue with your original code was likely that it wasn't explicitly checking for the target sheet name or looping through all sheets in each workbook. Here's a working implementation:

Sub CombineMathResults()
    Dim masterBook As Workbook
    Dim masterSheet As Worksheet
    Dim sourceBook As Workbook
    Dim sourceSheet As Worksheet
    Dim folderPath As String
    Dim fileName As String
    Dim lastRowMaster As Long
    Dim lastRowSource As Long
    Dim firstCopy As Boolean
    
    ' Initialize flag to keep headers only once
    firstCopy = True
    
    ' Let user select the folder containing class workbooks
    With Application.FileDialog(msoFileDialogFolderPicker)
        .Title = "Select Folder with Class Workbooks"
        If .Show = -1 Then
            folderPath = .SelectedItems(1) & "\"
        Else
            MsgBox "No folder selected. Exiting."
            Exit Sub
        End If
    End With
    
    ' Create new master workbook for merged data
    Set masterBook = Workbooks.Add
    Set masterSheet = masterBook.Sheets(1)
    masterSheet.Name = "Combined Math Results"
    
    ' Loop through all Excel files in the selected folder
    fileName = Dir(folderPath & "*.xlsx")
    Do While fileName <> ""
        ' Open source workbook in read-only mode to avoid locks
        Set sourceBook = Workbooks.Open(folderPath & fileName, ReadOnly:=True)
        
        ' Check each sheet in the source workbook
        For Each sourceSheet In sourceBook.Sheets
            ' Target only the "Math Result" sheet
            If sourceSheet.Name = "Math Result" Then
                lastRowMaster = masterSheet.Cells(masterSheet.Rows.Count, "A").End(xlUp).Row
                lastRowSource = sourceSheet.Cells(sourceSheet.Rows.Count, "A").End(xlUp).Row
                
                If firstCopy Then
                    ' Copy entire sheet including headers for the first entry
                    sourceSheet.UsedRange.Copy Destination:=masterSheet.Range("A1")
                    firstCopy = False
                Else
                    ' Copy only data (skip headers) for subsequent entries
                    sourceSheet.Range("A2:" & sourceSheet.Cells(lastRowSource, sourceSheet.UsedRange.Columns.Count).Address).Copy _
                        Destination:=masterSheet.Range("A" & lastRowMaster + 1)
                End If
                
                Exit For ' Stop checking other sheets once we find the target
            End If
        Next sourceSheet
        
        ' Close source workbook without saving changes
        sourceBook.Close SaveChanges:=False
        fileName = Dir() ' Get next file name
    Loop
    
    ' Auto-fit columns for readability
    masterSheet.UsedRange.Columns.AutoFit
    
    MsgBox "Math results merged successfully!", vbInformation
End Sub

Key Fixes & Explanations: #

• Explicit Sheet Check: The If sourceSheet.Name = "Math Result" line is the core fix—it ensures we only process the exact sheet you need, avoiding errors from multi-sheet workbooks.
• Header Handling: The firstCopy flag prevents duplicate header rows (remove this logic if you want headers repeated for each class).
• User-Friendly Folder Selection: Lets you pick the target folder instead of hardcoding paths, making the macro flexible.
• Read-Only Access: Opens source files in read-only mode to prevent editing locks and accidental changes.
• Cleanup: Automatically closes source workbooks and formats the master sheet for clarity.

How to Use: #

1. Open a blank Excel workbook.
2. Press Alt + F11 to open the VBA Editor.
3. Insert a new module (Right-click your workbook in the Project Explorer > Insert > Module).
4. Paste the code above into the module.
5. Press F5 to run the macro, then select the folder with your class workbooks.

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