Search Sheet1 and copy to sheet 2

[StuartWB2]

I have been tasked with a extracting some data from a spreadsheet not being that good i would like some help with VBA
all the data is on sheet 1 and there is duplicated through out.
the way it is layed out is where ever there is a part number there is a serial number in the right hand cell. What i want to do is use list of part numbers in Colmn A sheet 2 search in sheet 1 and Paste the found serial numbers next to the selected part numbers in sheet 2 if that maked sense.

Thanks

Sheet 1

Part 1	Serial
		part2	serial
				Part3	Serial
				Part 5	Serial

<tbody>
</tbody>

Sheet 2

Part 1	Serial
Part2
Part 3
Part 4
Part 5

<tbody>
</tbody>

 

[Akuini]

Try this:

Sub a1114933a()
Dim c As Range, f As Range

Application.ScreenUpdating = False
Sheets("Sheet 1").Activate

For Each f In Sheets("Sheet 2").Range("A1", Sheets("Sheet 2").Cells(Rows.Count, "A").End(xlUp))

    Set c = Cells.Find(What:=f.Value, LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False, SearchFormat:=False)
    If Not c Is Nothing Then f.Offset(, 1).Value = c.Offset(, 1).Value
    
Next

Application.ScreenUpdating = True

End Sub

Note: the sheet's name is "Sheet 1" not "Sheet1", isn't it?

 

[StuartWB2]

Try this:

Sub a1114933a()
Dim c As Range, f As Range

Application.ScreenUpdating = False
Sheets("Sheet 1").Activate

For Each f In Sheets("Sheet 2").Range("A1", Sheets("Sheet 2").Cells(Rows.Count, "A").End(xlUp))

    Set c = Cells.Find(What:=f.Value, LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False, SearchFormat:=False)
    If Not c Is Nothing Then f.Offset(, 1).Value = c.Offset(, 1).Value
    
Next

Application.ScreenUpdating = True

End Sub

Note: the sheet's name is "Sheet 1" not "Sheet1", isn't it?

Works a treat many thanks

 

[Akuini]

You're welcome, glad to help, & thanks for the feedback.