使用唯一标识符复制粘贴数据

时间:2017-01-25 10:49:12

标签: excel vba excel-vba

我想使用以下VBA代码来链接同一工作簿中的两个工作表中的数据。两个工作表中的每个条目都有唯一的标识符。我希望使用该标识符并从sheet2复制整行并将其从sheet1最后一列的右侧移过。

如何修复此代码?

Sub link_data()
    Dim i, lastrow
    im i2, lastrow2

    Dim A As Double
    Dim D As Double
    lastrow = Sheet1.Range("A" & Rows.Count).End(xlUp).Row
    lastrow2 = Sheet2.Range("A" & Rows.Count).End(xlUp).Row
    For i = 2 To lastrow
    For i2 = 2 To lastrow2
    Set D = Sheet1.Cells(i, "AW")
    Set A = Sheet2.Cells(i2, "AI")
    If Sheet1.Cells(D).Value = Sheet2.Cells(A) Then
    Sheet2.Cells(A).EntireRow.Copy Destination:=Sheet1.Cells(i, "AX").end(xlRight).Offset(1)
End Sub

2 个答案:

答案 0 :(得分:0)

因为我没有任何虚拟数据来重现它实际上那种艰难。但请尝试使用以下数据,并让我知道会发生什么

Option Explicit
Sub link_data()
Dim i, lastrow
Dim i2, lastrow2
Dim A
Dim D

lastrow = Sheet1.Range("A" & Rows.Count).End(xlUp).Row
lastrow2 = Sheet2.Range("A" & Rows.Count).End(xlUp).Row

For i = 2 To lastrow
    For i2 = 2 To lastrow2
    Set D = Sheets("Sheet1").Cells(i, "AW")
    Set A = Sheets("Sheet2").Cells(i2, "AI")
        If Sheet1.Cells(D).Value = Sheet2.Cells(A) Then
            Sheet2.Cells(i2, "AI").EntireRow.Copy Destination:=Sheet1.Cells(i, "AX")
        End If
    Next i2
Next i

End Sub

答案 1 :(得分:0)

也许你在此之后:

Sub link_data()
    Dim i As Long, lastrow As Long, i2 As Long, lastrow2 As Long
    Dim A As Range, D As Range

    lastrow = Sheet1.Range("A" & Rows.Count).End(xlUp).Row
    lastrow2 = Sheet2.Range("A" & Rows.Count).End(xlUp).Row
    For i = 2 To lastrow
        Set D = Sheet1.Cells(i, "AW")
        For i2 = 2 To lastrow2
            Set A = Sheet2.Cells(i2, "AI")
            If D.Value = A.Value Then
                Intersect(A.Parent.UsedRange, A.EntireRow).Copy Destination:=Sheet1.Cells(i, Columns.Count).End(xlToLeft).Offset(, 1)
            End If
        Next
    Next
End Sub