Macro to find cell value in another sheet and copy and paste adjacent row to different sheet

[Bran4642]

Hello! I have the following code below and it works great but I need to add to it if possible!

I am running a macro in sheet1 on active cell column C and matching it to sheet2 column B cell that works fine. But what I need now is when the match is found on sheet2 column B I need to copy the row adjacent to it in column C and paste it in sheet1 column D beside the active cell I was previously searching. Is this possible if so I could use some help. Below is the code I am using now.

Sub Test()
rngY = ActiveCell.Value
Sheets("Sheet2").Select
Columns("B:B").Select
Selection.Find(What:=rngY, After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate

ActiveCell.Select
End Sub

 

[Fluff]

How about

Sub Bran4642()
   Dim Fnd As Range
   Dim RngY As Variant
   
   RngY = ActiveCell.Value
   Set Fnd = Sheets("Sheet2").Columns("B:B").Find(RngY, , xlFormulas, xlWhole, xlByRows, xlNext, False, , False)
   If Not Fnd Is Nothing Then ActiveCell.Offset(, 1).Value = Fnd.Offset(, 1).Value
End Sub

 

[Bran4642]

Fluff this works perfectly!! Thank you so much!!

 

[Bran4642]

Fluff,

Is it possible to run the macro down the whole sheet and it do all that automatically without have to click on the active cell?

 

[Fluff]

Yup, like

Sub Bran4642()
   Dim Fnd As Range, Cl As Range
   
   With Sheets("sheet1")
      For Each Cl In .Range("C2", .Range("C" & Rows.Count).End(xlUp))
         Set Fnd = Sheets("Sheet2").Columns("B:B").Find(Cl.Value, , xlFormulas, xlWhole, xlByRows, xlNext, False, , False)
         If Not Fnd Is Nothing Then Cl.Offset(, 1).Value = Fnd.Offset(, 1).Value
      Next Cl
   End With
End Sub

 

[Bran4642]

Fluff,

This worked perfectly! Thank you so much for your help and expertise!!

 

[Fluff]

You're welcome & thanks for the feedback