Find values on column search the values in another sheet then copying data then pasting it into first sheet

[xjpx]

Hi all, I want to use VBA for excel to look for all values(ID) of Sheet1 (eg. image 1) column A which is located in Sheet2 (eg. image 2). Then I want it to copy the data of the 2 columns (eg. image 2) beside the value of Sheet2 into Sheet1's columns C and D (eg. image 3). The final product should look like image 3 which is in Sheet 1.
Hope someone is able to help me with this.

Below is the script that I have written but it doesn't work.

Sub ID()

Dim ID&, i&
Dim cell As Range
Dim arr(1 To 1000000, 1 To 2)

With Sheets("Sheet 1")
ID = .Cells(Rows.Count, "A").End(xlUp).Row
For Each cell In .Range("A2:A" & ID)
If cell > 0 Then
i = i + 1
arr(i, 1) = cell
Selection.Copy
End If
Next
End With

Sheets("Sheet 2").Select
ActiveCell.Offset(0, -1).Columns("A:A").EntireColumn.Select
Selection.Find(What:="", After:=ActiveCell, LookIn:=xlFormulas2, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=True, SearchFormat:=False).Activate
Range(Selection, Selection.End(xlToRight)).Select
Selection.Copy

Sheets("Sheet 1").Cells(2, 3).Resize(i, 4).ActiveSheet.Paste

End Sub

 

[Zot]

I hope I understood your explanation right. Try this

Sub FindCopy()

Dim cell As Range, rngID As Range, rngFound As Range, rngSearch As Range
Dim ws1 As Worksheet, ws2 As Worksheet

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

Set rngID = ws1.Range("A2", ws1.Cells(Rows.Count, "A").End(xlUp))
Set rngSearch = ws2.Range("A2", ws2.Cells(Rows.Count, "A").End(xlUp))

For Each cell In rngID
    Set rngFound = rngSearch.Find(cell, LookAt:=xlWhole)
    If Not rngFound Is Nothing Then
        ws2.Range("C" & rngFound.Row, "D" & rngFound.Row).Copy ws1.Range("C" & cell.Row)
    End If
Next

End Sub

 

[xjpx]

I hope I understood your explanation right. Try this

Sub FindCopy()

Dim cell As Range, rngID As Range, rngFound As Range, rngSearch As Range
Dim ws1 As Worksheet, ws2 As Worksheet

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

Set rngID = ws1.Range("A2", ws1.Cells(Rows.Count, "A").End(xlUp))
Set rngSearch = ws2.Range("A2", ws2.Cells(Rows.Count, "A").End(xlUp))

For Each cell In rngID
    Set rngFound = rngSearch.Find(cell, LookAt:=xlWhole)
    If Not rngFound Is Nothing Then
        ws2.Range("C" & rngFound.Row, "D" & rngFound.Row).Copy ws1.Range("C" & cell.Row)
    End If
Next

End Sub

Thank you. This is exactly what I wanted.

 

[Zot]

Thank you. This is exactly what I wanted.

Glad could help