请求协助：通过表头名称复制Excel列（附问题VBA代码）

Let's walk through the problems in your code and fix them to get the "User ID" column copied to your CheckSheet correctly.

Key Issues in Your Original Code #

• Missing Variable Declarations: ws1 and i aren't declared with Dim, which can lead to unexpected errors (always use Option Explicit at the top of your module to catch this).
• Redundant ActiveSheet Reference: Sheets(ActiveSheet.Name) is the same as just ActiveSheet, but relying on ActiveSheet can cause bugs if the user switches sheets while the macro runs.
• Unnecessary Selection: Using .Select and Set source = Selection is inefficient and can break if the selection changes mid-macro. We can directly reference the range instead.
• Incorrect Copy Destination: source.Copy ([ws1]) doesn't specify where to paste the column in CheckSheet. You need to target a specific cell or column.
• Hardcoded Column Limit: Looping up to 50 columns might miss the header if it's beyond column 50; better to find the last used column dynamically.

Corrected VBA Code #

Option Explicit ' Always include this to catch undeclared variables

Sub FindThenCopy()
    Dim sourceWs As Worksheet
    Dim targetWs As Worksheet
    Dim headerCell As Range
    Dim lastCol As Long
    Dim targetCol As Range
    
    ' Set your source and target worksheets explicitly
    Set sourceWs = ActiveSheet ' Or use Worksheets("YourSourceSheetName") for safety
    Set targetWs = Worksheets("CheckSheet")
    
    ' Find the last used column in the source worksheet's header row (row 1)
    lastCol = sourceWs.Cells(1, sourceWs.Columns.Count).End(xlToLeft).Column
    
    ' Loop through header row to find "User ID"
    For Each headerCell In sourceWs.Range(sourceWs.Cells(1, 1), sourceWs.Cells(1, lastCol))
        If headerCell.Value = "User ID" Then
            ' Define the entire column with data
            sourceWs.Columns(headerCell.Column).Copy
            
            ' Paste to the first column of CheckSheet
            targetWs.Columns(1).PasteSpecial Paste:=xlPasteAll
            
            Exit For ' Exit loop once we find the header
        End If
    Next headerCell
    
    ' Clear the clipboard to avoid "marching ants"
    Application.CutCopyMode = False
End Sub

Improvements Explained #

1. Option Explicit: Forces you to declare all variables, preventing typos and undefined variable errors.
2. Explicit Worksheet References: We set sourceWs and targetWs directly, so the macro doesn't depend on the active sheet being correct.
3. Dynamic Column Range: Instead of looping to 50, we find the last used column in the header row, so we don't miss any possible headers.
4. No Selection: We directly reference the column without selecting it, making the macro faster and more reliable.
5. Clear Copy Mode: After pasting, we turn off CutCopyMode to remove the selection border from the copied column.

Alternative: Using Find Method (Simpler) #

If you prefer a shorter version using Excel's Find function instead of looping:

Option Explicit

Sub FindThenCopy_Faster()
    Dim sourceWs As Worksheet
    Dim targetWs As Worksheet
    Dim headerFound As Range
    
    Set sourceWs = ActiveSheet
    Set targetWs = Worksheets("CheckSheet")
    
    ' Use Find to locate the "User ID" header
    Set headerFound = sourceWs.Rows(1).Find(What:="User ID", LookIn:=xlValues, LookAt:=xlWhole)
    
    If Not headerFound Is Nothing Then
        ' Copy the entire column to targetWs's first column
        sourceWs.Columns(headerFound.Column).Copy targetWs.Columns(1)
        Application.CutCopyMode = False
    Else
        MsgBox "Header 'User ID' not found in source sheet!", vbExclamation
    End If
End Sub

This version uses Find which is more efficient than looping, and includes a message box if the header isn't found (so you know why nothing happened).

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