需求：通过VBA实现按指定表头匹配复制数据至目标工作表

• 源工作表中，用户选择年份和周数后，D7:D28区域会生成对应周的数据
• D2单元格通过公式生成唯一表头（如“周X-XXXX”格式），目标工作表中存在相同格式的表头
• 需要编写VBA代码，将源表D7:D28的数据复制到目标表对应表头的下方位置

Sub CopyWeekDataToTarget()
    Dim wsSource As Worksheet
    Dim wsTarget As Worksheet
    Dim sourceHeader As String
    Dim targetHeaderCell As Range
    Dim pasteStartRow As Long
    
    ' 替换为实际的源/目标工作表名称
    Set wsSource = ThisWorkbook.Worksheets("源工作表")
    Set wsTarget = ThisWorkbook.Worksheets("目标工作表")
    
    ' 获取源表的唯一表头
    sourceHeader = wsSource.Range("D2").Value
    If sourceHeader = "" Then
        MsgBox "源表表头为空，请检查D2单元格公式！", vbExclamation
        Exit Sub
    End If
    
    ' 在目标表第一行精准匹配表头
    Set targetHeaderCell = wsTarget.Rows(1).Find(What:=sourceHeader, LookIn:=xlValues, LookAt:=xlWhole)
    If targetHeaderCell Is Nothing Then
        MsgBox "目标表中未找到匹配的表头：" & sourceHeader, vbExclamation
        Exit Sub
    End If
    
    ' 定位对应列的第一个空行（表头下的第一个可用行）
    pasteStartRow = wsTarget.Cells(wsTarget.Rows.Count, targetHeaderCell.Column).End(xlUp).Row + 1
    
    ' 复制数据并粘贴（仅粘贴数值，如需格式可改为xlPasteAll）
    wsSource.Range("D7:D28").Copy
    wsTarget.Cells(pasteStartRow, targetHeaderCell.Column).PasteSpecial Paste:=xlPasteValues
    Application.CutCopyMode = False
    
    MsgBox "数据复制完成！", vbInformation
End Sub

• 工作表名称修改：代码中的"源工作表"和"目标工作表"需要替换成你实际使用的工作表名称
• 表头匹配逻辑：使用Find方法精准匹配表头（LookAt:=xlWhole避免部分匹配），确保找到完全一致的表头列
• 粘贴位置定位：通过End(xlUp)找到目标列的最后一行数据，下一行即为新数据的起始行，避免覆盖已有数据
• 粘贴选项：默认使用xlPasteValues仅粘贴数值，若需要保留源表的格式、公式等，可将参数改为xlPasteAll

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