基于列标题复制粘贴的Excel Macro开发求助

Got it, let's solve this Excel Macro task for you. As someone new to VBA, I'll make this straightforward with a complete, commented code and clear explanations so you can adapt it easily.

We need to:

• Locate the column named Sort in Workbook 1's Sheet 1, copy all its data (rows can vary in number)
• Paste this data into the column named Name in Workbook 2's Sheet 2

Open the VBA editor (press Alt + F11), insert a new module, and paste this code:

Sub CopyColumnByHeader()
    Dim wbSource As Workbook
    Dim wsSource As Worksheet
    Dim wbTarget As Workbook
    Dim wsTarget As Worksheet
    
    Dim sourceHeader As String
    Dim targetHeader As String
    Dim sourceCol As Range
    Dim targetCol As Range
    Dim lastRowSource As Long
    Dim lastRowTarget As Long
    
    ' Define your header names (adjust these if your headers are different)
    sourceHeader = "Sort"
    targetHeader = "Name"
    
    ' Set source workbook and worksheet (change names if your files are named differently)
    ' If Workbook 1 is the one with the macro, use ThisWorkbook instead
    Set wbSource = Workbooks("Workbook1.xlsx") ' Replace with your actual source workbook name
    Set wsSource = wbSource.Sheets("Sheet1")
    
    ' Set target workbook and worksheet
    On Error Resume Next ' Handle case if target workbook isn't open
    Set wbTarget = Workbooks("Workbook2.xlsx")
    On Error GoTo 0
    
    ' If target workbook isn't open, prompt user to open it
    If wbTarget Is Nothing Then
        Dim filePath As String
        filePath = Application.GetOpenFilename("Excel Files (*.xlsx; *.xls), *.xlsx; *.xls")
        If filePath = "False" Then
            MsgBox "Target workbook not selected. Macro canceled."
            Exit Sub
        End If
        Set wbTarget = Workbooks.Open(filePath)
    End If
    Set wsTarget = wbTarget.Sheets("Sheet2")
    
    ' Find source column by header
    Set sourceCol = wsSource.Rows(1).Find(What:=sourceHeader, LookIn:=xlValues, LookAt:=xlWhole)
    If sourceCol Is Nothing Then
        MsgBox "Source header '" & sourceHeader & "' not found in Sheet1."
        Exit Sub
    End If
    
    ' Find target column by header
    Set targetCol = wsTarget.Rows(1).Find(What:=targetHeader, LookIn:=xlValues, LookAt:=xlWhole)
    If targetCol Is Nothing Then
        MsgBox "Target header '" & targetHeader & "' not found in Sheet2."
        Exit Sub
    End If
    
    ' Get last row with data in source column (skip header row)
    lastRowSource = wsSource.Cells(wsSource.Rows.Count, sourceCol.Column).End(xlUp).Row
    If lastRowSource <= 1 Then
        MsgBox "No data found in source column '" & sourceHeader & "'."
        Exit Sub
    End If
    
    ' Clear existing data in target column (keep header)
    wsTarget.Range(targetCol.Offset(1), wsTarget.Cells(wsTarget.Rows.Count, targetCol.Column).End(xlUp)).ClearContents
    
    ' Copy data from source to target
    wsSource.Range(sourceCol.Offset(1), wsSource.Cells(lastRowSource, sourceCol.Column)).Copy _
        Destination:=wsTarget.Cells(2, targetCol.Column)
    
    ' Optional: Clear clipboard to avoid "marching ants"
    Application.CutCopyMode = False
    
    MsgBox "Data copied successfully!", vbInformation
End Sub

Let's break down what each part does:

• Workbook/Worksheet Setup: We define which workbooks and sheets to use. If the target workbook isn't open, the macro will prompt you to select it.
• Header Search: Uses Find to locate the columns by their header names—this works even if the columns are moved around (no hardcoded column letters!).
• Dynamic Row Count: End(xlUp) finds the last row with data in the source column, so it automatically handles varying numbers of rows.
• Data Handling: Clears existing data in the target column (keeping the header) before pasting, then copies the source data and pastes it starting from the row below the target header.
• Error Handling: Includes checks for missing headers, empty source data, and missing target workbooks to prevent crashes and give clear messages.

1. Save your Workbook 1 as a macro-enabled workbook (*.xlsm).
2. Open both Workbook 1 and Workbook 2 (or let the macro prompt you to open Workbook 2).
3. Run the macro (press Alt + F8, select CopyColumnByHeader, then click Run).

This should handle all your requirements, even when the number of data rows changes!

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