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

[TABLE="width: 500"]
<tbody>[TR]
[TD]Part 1[/TD]
[TD]Serial [/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD]part2[/TD]
[TD]serial[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]Part3[/TD]
[TD]Serial[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]Part 5[/TD]
[TD]Serial[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]


Sheet 2 [TABLE="width: 100"]
<tbody>[TR]
[TD]Part 1[/TD]
[TD]Serial[/TD]
[/TR]
[TR]
[TD]Part2
[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Part 3[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Part 4[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Part 5[/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]

 

[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.