如何基于单元格值批量将数据复制到对应工作表？

Hey there! I totally get the pain of manually copying data for 500 entries—let's fix that with an efficient VBA script that does all the heavy lifting for you. Here's a tailored solution for your scenario:

Core Idea #

We’ll loop through every row of your source data, grab the name from each entry, locate the corresponding worksheet you’ve already created, and copy the relevant data to that worksheet’s next empty row. No more repetitive manual work!

Full VBA Code #

Sub BatchCopyDataToSheets()
    Dim wsSource As Worksheet
    Dim wsTarget As Worksheet
    Dim lastRow As Long
    Dim i As Long
    Dim targetName As String
    
    ' Set your source data worksheet (replace "Sheet1" with your actual data sheet name)
    Set wsSource = ThisWorkbook.Sheets("Sheet1")
    
    ' Get the last row with data in your source sheet (assuming names are in column A)
    lastRow = wsSource.Cells(wsSource.Rows.Count, "A").End(xlUp).Row
    
    ' Loop through each data row (start at row 2 to skip header row)
    For i = 2 To lastRow
        ' Extract the name from the current row (adjust column letter if names aren't in A)
        targetName = wsSource.Cells(i, "A").Value
        
        ' Skip rows with empty names to avoid errors
        If targetName <> "" Then
            ' Try to find the worksheet matching the name
            On Error Resume Next
            Set wsTarget = ThisWorkbook.Sheets(targetName)
            On Error GoTo 0
            
            ' If the worksheet exists, copy the row to it
            If Not wsTarget Is Nothing Then
                ' Copy the entire row to the next empty row in the target sheet
                wsSource.Rows(i).Copy Destination:=wsTarget.Cells(wsTarget.Rows.Count, "A").End(xlUp).Offset(1, 0)
                
                ' Optional: Clear clipboard to free up memory and remove copy selection
                Application.CutCopyMode = False
                
                ' Reset target worksheet variable for next iteration
                Set wsTarget = Nothing
            End If
        End If
    Next i
    
    MsgBox "Data copying completed successfully!", vbInformation
End Sub

Key Customizations You Need to Make #

• Source Sheet Name: Replace "Sheet1" with the actual name of your data-containing worksheet.
• Name Column: If your names are not in column A, update "A" in both wsSource.Cells(i, "A").Value and lastRow = wsSource.Cells(wsSource.Rows.Count, "A").End(xlUp).Row to the correct column letter (e.g., "B" for column B).
• Case Sensitivity: If your worksheet names don’t match the case of names in your data (e.g., sheet name is "John Doe" but data has "john doe"), adjust the targetName line to match:

  targetName = UCase(wsSource.Cells(i, "A").Value) ' Use this if sheets are uppercase
  ' OR
  targetName = LCase(wsSource.Cells(i, "A").Value) ' Use this if sheets are lowercase
  

• Specific Columns Only: If you don’t need the entire row, replace wsSource.Rows(i).Copy with a range of specific columns (e.g., wsSource.Range("A" & i & ",C" & i & ",E" & i).Copy for columns A, C, E).

How to Run the Code #

1. Open your Excel file with the source data and pre-generated name worksheets.
2. Press Alt + F11 to open the VBA Editor.
3. Right-click your workbook in the Project Explorer (left pane) → Insert → Module.
4. Paste the code into the new module window.
5. Make the customizations listed above.
6. Press F5 or click the green play icon in the editor to run the macro.

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