我来帮你搞定这个Excel宏的需求，结合你的描述，我整理了完整的VBA代码，还会拆解每一步的逻辑，方便你调试和修改：

Sub MatchAndCopyData()
    Dim ws1 As Worksheet, ws2 As Worksheet
    Dim lastRowWs1 As Long, lastRowWs2 As Long
    Dim i As Long, j As Long, matchRow As Long
    
    ' 定义工作表对象，可根据实际表名修改
    Set ws1 = ThisWorkbook.Sheets("Sheet1")
    Set ws2 = ThisWorkbook.Sheets("Sheet2")
    
    ' 获取两个表的最后一行数据，避免遍历空行
    lastRowWs1 = ws1.Cells(ws1.Rows.Count, "A").End(xlUp).Row
    lastRowWs2 = ws2.Cells(ws2.Rows.Count, "A").End(xlUp).Row
    
    ' 遍历Sheet2中A列的每一行数据（假设第一行是表头，从第二行开始）
    For i = 2 To lastRowWs2
        ' 在Sheet1的A列查找当前Sheet2 A列的值
        On Error Resume Next
        matchRow = ws1.Columns("A").Find(What:=ws2.Cells(i, "A").Value, LookIn:=xlValues, LookAt:=xlWhole).Row
        On Error GoTo 0
        
        ' 如果找到匹配的行
        If matchRow > 0 Then
            ' 遍历Sheet1的D3到M3区域（对应列号4到13）
            For j = 4 To 13
                ' 比对Sheet1当前列的D3:M3值和Sheet2当前行的M列值
                If ws1.Cells(3, j).Value = ws2.Cells(i, "M").Value Then
                    ' 复制Sheet1对应列的D2:M2值到Sheet2的P列
                    ws2.Cells(i, "P").Value = ws1.Cells(2, j).Value
                    ' 找到匹配后退出循环，避免重复赋值
                    Exit For
                End If
            Next j
        End If
    Next i
    
    MsgBox "数据匹配与复制完成！", vbInformation
End Sub

• 工作表对象定义：用ws1和ws2指代两个工作表，后续如果表名修改，只需要改这里的字符串即可，不用全局替换。
• 获取最后一行：避免遍历整个列的空行，提升运行效率，适合数据量大的情况。
• 匹配A列值：使用Find方法精准匹配Sheet2 A列和Sheet1 A列的值，找不到匹配时matchRow会保持0，跳过后续逻辑。
• 比对与复制：循环Sheet1的D3到M3（列4到13），当找到和Sheet2 M列相同的值时，把Sheet2对应行的P列赋值为Sheet1对应列的D2:M2值，找到后立即退出循环，避免重复操作。
• 错误处理：用On Error Resume Next处理找不到匹配的情况，防止宏报错中断。

1. 打开你的Excel文件，按下Alt + F11打开VBA编辑器。
2. 在左侧工程窗口右键点击你的工作簿，选择「插入」→「模块」。
3. 将上面的代码粘贴到新建的模块中。
4. 按下F5运行宏，或者回到Excel界面，点击「开发工具」→「宏」，选择MatchAndCopyData执行。

如果你的表头行不是第1行，或者数据起始行有变化，只需要修改代码中For i = 2 To lastRowWs2的起始数字即可。

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