比较两张纸的匹配值，然后将匹配的两张纸粘贴到第三张纸上

Question

我想比较两张纸，一张纸上有2019年每个月的父级和项目详细信息行，另一张纸上有交付管理器。我想从第一列的第二个复制交付管理器名称-第三并将此组合的所有行从第一个复制到第三张

我尝试将送货经理的姓名复制到第二名。可以

Sub CopyDM()
    Dim LastRow1 As Integer, i As Integer, erow As Integer, LastRow2 As Integer, j As Integer, lastrow3 As Integer
    Dim wbSrc As Workbook
    Dim wsSrc As Worksheet
    Dim Newwb As Workbook
    Dim Newws As Worksheet
    Dim wbDst As Workbook
    Dim wsDst As Worksheet

    Set wbDst = Workbooks("2019-07-11.xlsm")
    Set wsDst = wbDst.Worksheets("2019-07-11")
    Set Newwb = Workbooks("Copyrows.xlsm")

    Set wbSrc = Workbooks("Project_ID_Master_List_report.xlsm")
    Set wsSrc = wbSrc.Worksheets("Project_ID_Master_List_report")
    Set Newws = Newwb.Worksheets("Sheet1")

    LastRow1 = wsDst.Range("A" & wsDst.Rows.Count).End(xlUp).Row
    LastRow2 = wsSrc.Range("A" & wsSrc.Rows.Count).End(xlUp).Row    

    For i = 2 To LastRow1
        For j = 2 To LastRow2
            If wsSrc.Cells(j, 2).Value = wsDst.Cells(i, 5).Value And _
              wsSrc.Cells(j, 5).Value = wsDst.Cells(i, 2).Value Then
                wsSrc.Cells(j, 3).Copy wsDst.Cells(i, 15)
            End If
        Next j
    Next i         
End Sub

---

Sub CopyDM()
    Dim LastRow1 As Integer, i As Integer, LastRow2 As Integer, j As Integer, lastrow3 As Integer, LastCol As Integer, k As Integer

    Dim wbSrc As Workbook
    Dim wsSrc As Worksheet
    Dim Newwb As Workbook
    Dim Newws As Worksheet
    Dim wbDst As Workbook
    Dim wsDst As Worksheet

    Set wbDst = Workbooks("2019-07-11.xlsm")
    Set wsDst = wbDst.Worksheets("2019-07-11")
    Set Newwb = Workbooks("Copyrows.xlsm")

    Set wbSrc = Workbooks("Project_ID_Master_List_report.xlsm")
    Set wsSrc = wbSrc.Worksheets("Project_ID_Master_List_report")
    Set Newws = Newwb.Worksheets("Sheet1")

    LastRow1 = wsDst.Range("A" & wsDst.Rows.Count).End(xlUp).Row
    LastRow2 = wsSrc.Range("A" & wsSrc.Rows.Count).End(xlUp).Row
    ' lastrow3 = Newws.Range("A" & Newws.Rows.Count).End(xlUp).Row

    LastCol = Sheets("wsDst").Cells(1, Columns.Count).End(xlToLeft).Column

    For i = 2 To LastRow1
        For j = 2 To LastRow2
            lastrow3 = Newws.Range("A" & Newws.Rows.Count).End(xlUp).Row

            For k = 1 To LastCol
                If wsSrc.Cells(j, 2).Value = wsDst.Cells(i, 5).Value And _
                  wsSrc.Cells(j, 5).Value = wsDst.Cells(i, 2).Value Then
                    Newws.Cells(lastrow3, 1).Copy wsDst.Cells(i, 15)
                End If
            Next k
        Next j
    Next i    
End Sub