VBA Code which Search and find the value to be copied

[ExcelMentee]

Looking for a VBA code which performs the following action.

That If Sheet1.Range("A1").Value = 2002_2550 or Text or Number

then Find that value in Sheet2.Range("A:A") If that number Matches then then copy the same cell of Col"B"

and then paste copied value in to Sheet3.Range("C15") till the ColB used range.

 

[Zot]

If that number Matches then then copy the same cell of Col"B" and then paste copied value in to Sheet3.Range("C15") till the ColB used range.

This part is not clear. Say you find match in Sheet2 column A in row 9 (for example).
Then copy what in column B? Start from range B9 until end of data row to sheet3("C15")?

 

[ExcelMentee]

Zot, thank you for the response. Please have a look below​

I have this number in Sheet1

Code will find that Sheet1 value in Sheet2 Col"A" then copy the Col"B" value that is "156". (If that number Matches then then copy the same cell of Col"B")

After that code will paste that "156" VALUE IN Sheet3.Range("C2") to till where Col"B" used range end. (and then paste copied value in to Sheet3.Range("C15") till the ColB used range.|)

 

[Zot]

I have no idea if the value in sheet1 is only one or many and always at B4. So, assume at B4.
For used range in sheet3, I just refer to end of row in column B as last filled range starting from C15.

Sub Search_Transfer()

Dim cell As Range, rngData As Range, rngPaste
Dim ws1 As Worksheet, ws2 As Worksheet, ws3 As Worksheet

Set ws1 = ActiveWorkbook.Sheets("Sheet1")
Set ws2 = ActiveWorkbook.Sheets("Sheet2")
Set ws3 = ActiveWorkbook.Sheets("Sheet3")

Set rngUsedRow = ws2.Range("A1", ws2.Range("A" & ws2.Rows.Count).End(xlUp))

For Each cell In rngUsedRow
    If cell = ws1.Range("B4") Then
        Set rngPaste = ws3.Range("B15", ws3.Range("B" & ws3.Rows.Count).End(xlUp)).Offset(0, 1)
        rngPaste.Value = cell.Offset(0, 1)
        Exit For
    End If
Next

End Sub

 

[ExcelMentee]

Thank you for the help.