0
votes

I want to use following VBA code to link data from two sheets which are within same workbook. Each entry in both sheets have a unique identifier. I am hoping to use that identifier and copy whole row from sheet2 and past it on the right hand side of sheet1's last column.

How to fix this code?

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
Close each of your For with Next (you have 2 For loops), and also close your If with End If.Shai Rado
Improved formatting and deleted useless text.help-info.de

2 Answers

0
votes

Seeing as i do not have any dummy data to reproduce its actually kind of tough. But try the below with your data and let me know what happens

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
0
votes

maybe you're after this:

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