根据匹配条件复制值

Question

数据表

我有两本内容相同的工作簿。 当项目编号和部门相同时，我将金额值从一个工作簿工作表复制并粘贴到另一个工作簿工作表。 金额必须粘贴在匹配的行中。 我面临的问题是所有金额都被复制但没有粘贴在相应的匹配项附近。

我使用的代码如下：

    ws1PRNum = "E"         'Project Number
    ws1Div = "I"        'Division
    ws2PRNum = "E"         'Project Number
    ws2Div = "I"        'Division

    
   'Setting first and last row for the columns in both sheets
    ws1PRRow = 5              'The row we want to start processing first
    ws1EndRow = wsSrc.UsedRange.Rows(wsSrc.UsedRange.Rows.count).Row
    ws2PRRow = 5              'The row we want to start search first
    ws2EndRow = wsDest.UsedRange.Rows(wsDest.UsedRange.Rows.count).Row

For i = ws1PRRow To ws1EndRow        'first and last row
        searchKey = wsSrc.Range(ws1PRNum & i) & wsSrc.Range(ws1Div & i) 'PR line and number is Master Backlog
         'if we have a non blank search term then iterate through possible matches
        If (searchKey <> "") Then
            For j = ws2PRRow To ws2EndRow 'first and last row
                 foundKey = wsDest.Range(ws2PRNum & j) & wsDest.Range(ws2Div & j) 'PR line and number in PR Report
                  'Copy result if there is a match between PR number and line in both sheets
                 If (searchKey = foundKey) Then
                    'Copying data where the rows match
                        wsDest.Range("AJ5", "AU1200").Value = wsSrc.Range("AJ5", "AU1200").Value
                        wsDest.Range("BB5", "BM1200").Value = wsSrc.Range("BB5", "BM1200").Value
                        wsDest.Range("BT5", "BU1200").Value = wsSrc.Range("BT5", "BU1200").Value
                    Exit For
                 End If
            Next
        End If
    Next

这是导致问题的区域。 如图所示，即使在部门和项目编号为空的行中，金额也会粘贴。 任何相同的答案都将受到高度赞赏，因为我不熟悉 VBA。

Answer 1

你可以这样做：

wsDest.Range("AJ" & j, "AU" & j).Value = wsSrc.Range("AJ" & i, "AU" & i).Value
'etc...

或者少一点串联：

wsDest.Rows(j).Range("AJ1:AU1").Value = wsSrc.Rows(i).Range("AJ1:AU1").Value