Match Cell Data Based on Cell Value and Iterate Down Rows-CodePudding

I have a sheet ("Sheet D") with different column headings than ("Sheet A") except for column A which is a part numbers column. I need to be able to go to ("Sheet D") and iterate down each row column A for the part number and find the matching part number in ("Sheet A") column A. If the part number from ("Sheet D") is found in ("Sheet A"), I need to copy the entire row where it was found and paste it into ("Sheet D") starting in column K. If the part number is not found in ("Sheet A"), I want it to skip that row in ("Sheet D") and leave it blank and move to the row below it and repeat. So far, I have this code but it doesn't work:

Sub Excel()

Dim N As Long
Dim i As Long
Dim j As Long
PN As Range
PNRow As Long

With Worksheets("Sheet A").Columns("A")
        N = Cells(Rows.Count, "A").End(xlUp).Row
        
        For i = 2 To N
              For j = 2 To N
                    Set PN = .Find(Worksheets("Sheet D").Cells(i, "A").Value, LookIn:=xlValues)
                    If PN Is Nothing Then
                            GoTo NextIteration
                    Else
                    PNRow = PN.Row
                    Range(Sheets("Sheet A").Cells(PNRow, 1), Sheets("Sheet A").Cells(PNRow, 10)).Copy Range(j, "K")
                    End If
NextIteration:
               Next j
        Next i

End With
End Sub

CodePudding user response：

Sub Update_Data()

    Dim d As Worksheet: Set d = ThisWorkbook.Worksheets("Sheet D")
    Dim a As Worksheet: Set a = ThisWorkbook.Worksheets("Sheet A")
    
    ' **IMPORTANT** header row locations
    Dim d_headerRow As Integer: d_headerRow = 1
    Dim a_headerRow As Integer: a_headerRow = 1
    
    Dim i As Long, j As Long, k As Integer, part As String
    Dim d_lastRow As Long: d_lastRow = d.Cells(d.Rows.Count, 1).End(xlUp).Row
    Dim a_lastRow As Long: a_lastRow = a.Cells(a.Rows.Count, 1).End(xlUp).Row
    Dim a_lastCol As Integer: a_lastCol = a.Cells(a_headerRow, a.Columns.Count).End(xlToLeft).Column
    
    For i = d_headerRow   1 To d_lastRow
        part = d.Cells(i, 1).Value
        
        For j = a_headerRow   1 To a_lastRow
            If part = a.Cells(j, 1).Value Then
                a.Range(a.Cells(j, 1), a.Cells(j, a_lastCol)).Copy Destination:=d.Range(d.Cells(i, 11), d.Cells(i, 11))
                Exit For
            End If
        Next j
    Next i

End Sub