如何将指定区域值作为VBA搜索变量并匹配对应目标工作表

Got it, let's tweak your VBA code to fit your new requirements perfectly. Here's the adjusted version, plus a breakdown of the key changes so you know exactly how it works:

Sub DynamicSearchAndCopy()
    Dim searchRng As Range, searchCell As Range
    Dim dataCell As Range
    Dim nextFreeRow As Long
    Dim searchValue As String
    Dim targetSheet As Worksheet
    
    ' Define the range of search values in "Items" worksheet (adjust to your actual range, e.g., "A2:A15")
    Set searchRng = Sheets("Items").Range("A1:A" & Sheets("Items").Cells(Sheets("Items").Rows.Count, "A").End(xlUp).Row)
    
    ' Loop through each search value from the "Items" sheet
    For Each searchCell In searchRng
        searchValue = searchCell.Value
        ' Skip empty cells in the search range to avoid unnecessary work
        If searchValue <> "" Then
            ' Check if the target worksheet exists (adds safety even if you said all are created)
            On Error Resume Next
            Set targetSheet = ThisWorkbook.Sheets(searchValue)
            On Error GoTo 0
            
            If Not targetSheet Is Nothing Then
                ' Loop through your data in Sheet1's H column
                With Sheets("Sheet1")
                    For Each dataCell In .Range("H1:H" & .Cells(.Rows.Count, "H").End(xlUp).Row)
                        ' Check if the current cell contains the search value
                        If InStr(dataCell.Value, searchValue) > 0 Then
                            ' Get the next empty row in the target worksheet
                            nextFreeRow = targetSheet.Cells(targetSheet.Rows.Count, "A").End(xlUp).Row + 1
                            
                            ' Copy the required columns (A,B,C,F) and the matching cell itself
                            Union(.Range("A" & dataCell.Row & ":C" & dataCell.Row), _
                                  .Range("F" & dataCell.Row), _
                                  dataCell).Copy _
                                  Destination:=targetSheet.Range("A" & nextFreeRow)
                        End If
                    Next dataCell
                End With
                ' Reset the target sheet reference for the next search value
                Set targetSheet = Nothing
            End If
        End If
    Next searchCell
End Sub

Key Updates & Explanations: #

• Dynamic Search Criteria: We first pull all non-empty values from the "Items" worksheet (adjust the searchRng line if your values are in a different column or range, like "B2:B20").
• Target Worksheet Matching: Each search value directly maps to a worksheet with the same name. The error handling ensures we skip any values where the worksheet doesn't exist (prevents crashes just in case).
• Cleaner Copy Operation: Instead of stringing together cell addresses, we use Union() to group the required columns (A-C, F) and the matching H cell into one copy action—this makes the code neater and more efficient.
• Safety Checks: We skip empty cells in the search range to avoid wasted loops.

Quick Notes: #

• If you only want to copy values (not formatting), replace the Copy block with this:

  Union(.Range("A" & dataCell.Row & ":C" & dataCell.Row), _
        .Range("F" & dataCell.Row), _
        dataCell).Copy
  targetSheet.Range("A" & nextFreeRow).PasteSpecial xlPasteValues
  Application.CutCopyMode = False
  

• Double-check the searchRng range to make sure it matches where your search values live in the "Items" sheet.

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