如何修改VBA代码实现从多可变工作表工作簿批量匹配导入数据？

Got it, let’s adjust your VBA code to handle every worksheet in Workbook 2 instead of just the first one. The core change is adding a loop that iterates through all sheets in Workbook 2, then runs your Index/Match (or VLOOKUP) logic for each sheet. Here’s a step-by-step solution:

Key Concept: Traverse All Worksheets #

Instead of targeting just wb2.Worksheets(1), we’ll use a For Each loop to go through every sheet in Workbook 2—regardless of how many there are or what they’re named. We’ll also add safeguards to avoid errors from empty sheets and ensure data is written correctly.

Modified VBA Code (Stored in Workbook 3) #

Sub ImportFromAllWB2SheetsToWB1()
    Dim wb1 As Workbook, wb2 As Workbook
    Dim wsTarget As Worksheet, wsSource As Worksheet
    Dim lastRowTarget As Long, lastRowSource As Long
    Dim lookupKeyCol As String, sourceValueCol As String, targetWriteCol As String
    Dim lookupRange As Range, valueRange As Range
    Dim i As Long
    
    ' --- CONFIGURE THESE VALUES TO MATCH YOUR DATA ---
    lookupKeyCol = "A" ' Column with matching IDs in both workbooks
    sourceValueCol = "C" ' Column in WB2 sheets with data to pull
    targetWriteCol = "B" ' Column in WB1's Sheet1 to write results
    ' --- END CONFIG ---
    
    ' Set references to your open workbooks (adjust filenames if needed)
    On Error GoTo WorkbookNotFound
    Set wb1 = Workbooks("Workbook1.xlsx")
    Set wb2 = Workbooks("Workbook2.xlsx")
    Set wsTarget = wb1.Worksheets("Sheet 1")
    On Error GoTo 0
    
    ' Get the last row with data in WB1's target sheet
    lastRowTarget = wsTarget.Cells(wsTarget.Rows.Count, lookupKeyCol).End(xlUp).Row
    
    ' Turn off screen updating for speed (optional but recommended)
    Application.ScreenUpdating = False
    
    ' Loop through EVERY worksheet in Workbook 2
    For Each wsSource In wb2.Worksheets
        ' Get last row with data in current WB2 sheet
        lastRowSource = wsSource.Cells(wsSource.Rows.Count, lookupKeyCol).End(xlUp).Row
        
        ' Skip empty sheets to avoid errors
        If lastRowSource < 2 Then GoTo NextSheet
        
        ' Define ranges for lookup key and value in current WB2 sheet
        Set lookupRange = wsSource.Range(lookupKeyCol & "2:" & lookupKeyCol & lastRowSource)
        Set valueRange = wsSource.Range(sourceValueCol & "2:" & sourceValueCol & lastRowSource)
        
        ' Match data to WB1's target sheet
        For i = 2 To lastRowTarget
            ' Use INDEX/MATCH to pull the value (0 = exact match)
            On Error Resume Next ' Ignore rows with no matching key
            wsTarget.Cells(i, targetWriteCol).Value = Application.Index(valueRange, _
                Application.Match(wsTarget.Cells(i, lookupKeyCol).Value, lookupRange, 0))
            On Error GoTo 0 ' Reset error handling
        Next i
        
NextSheet:
    Next wsSource
    
    ' Restore screen updating
    Application.ScreenUpdating = True
    MsgBox "Data imported from all Workbook 2 sheets successfully!", vbInformation
    Exit Sub
    
WorkbookNotFound:
    MsgBox "Make sure Workbook1.xlsx and Workbook2.xlsx are open!", vbExclamation
    Application.ScreenUpdating = True
End Sub

What’s Changed & Why? #

• For Each wsSource In wb2.Worksheets: This is the core fix—it automatically loops through every sheet in Workbook 2, no need to hardcode sheet names or counts.
• Configurable Columns: The top section lets you adjust which columns hold the lookup key, source data, and target write area without editing the core logic.
• Error Handling:
  • Skips empty sheets in Workbook 2 to avoid runtime errors.
  • Catches cases where Workbook 1 or 2 aren’t open and alerts you.
  • Ignores rows with no matching key so the code doesn’t crash mid-run.
• Performance: Disabling ScreenUpdating makes the code run much faster, especially with large datasets.

Important Notes #

1. Duplicate Keys: If the same lookup key exists in multiple Workbook 2 sheets, the later sheet’s value will overwrite earlier ones. To keep the first match instead, add a check before writing:

   If wsTarget.Cells(i, targetWriteCol).Value = "" Then
       wsTarget.Cells(i, targetWriteCol).Value = Application.Index(...)
   End If
   

2. VLOOKUP Alternative: If you prefer VLOOKUP over INDEX/MATCH, replace the INDEX/MATCH line with:

   wsTarget.Cells(i, targetWriteCol).Value = Application.VLookup(wsTarget.Cells(i, lookupKeyCol).Value, _
       wsSource.Range(lookupKeyCol & "2:" & sourceValueCol & lastRowSource), _
       wsSource.Columns(sourceValueCol).Column - wsSource.Columns(lookupKeyCol).Column + 1, False)
   

3. Closed Workbooks: If you need to work with closed Workbook 1/2, replace Workbooks("filename") with Workbooks.Open("C:\Path\To\Your\File.xlsx") (remember to close them afterward if needed).

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