Compare and copy dose nothing

[kwl]

Can someone point me in the right direction, I can get this to work
when I copy the entire row but I only want to copy a single cell to a
cell on the main page. Sheet1 is used as a part list with prices.

Sub copyData()
Dim rng1 As Range, rng2 As Range
Dim cell As Range, rw As Long
Dim sh As Worksheet
With Worksheets("Sheet1")
Set rng1 = .Range(.Cells(1, "A"), .Cells(.Rows.Count,
"A").End(xlUp))
End With
With Worksheets("node 1&2")
Set rng2 = .Range(.Cells(1, "B"), .Cells(.Rows.Count,
"B").End(xlUp))
End With
rw = 1
For Each cell In rng2
If cell.Value = rng1.Cells(Rows.Count, "A").Value Then
rng1.Cells(Rows.Count, "E").Copy Destination:=rng2.Cells(Rows.Count,
"E")
rw = rw + 1
End If
Next
End Sub

 

[kwl]

Any help at all?

 

[Dave Peterson]

I'm not sure what you're doing.

Are you trying to look for a match for each cell in rng2 and then copy the value
in column E to the matching row in sheet1?

If yes, maybe....

Option Explicit
Sub copyData()
Dim Rng1 As Range
Dim Rng2 As Range
Dim myCell As Range
Dim res As Variant

With Worksheets("Sheet1")
Set Rng1 = .Range(.Cells(1, "A"), .Cells(.Rows.Count, "A").End(xlUp))
End With

With Worksheets("node 1&2")
Set Rng2 = .Range(.Cells(1, "B"), .Cells(.Rows.Count, "B").End(xlUp))
End With

For Each myCell In Rng2.Cells
res = Application.Match(myCell.Value, Rng1, 0)
If IsError(res) Then
'no matching value
Else
myCell.Offset(0, 3).Copy _
Destination:=Rng1(res).Offset(0, 4)
End If
Next myCell

End Sub

But I'm really not sure if I copied the right cell--since one sheet has the key
in column A and the other in column B.

You may have to fiddle with this line:

myCell.Offset(0, 3).Copy _
Destination:=Rng1(res).Offset(0, 4)

..offset(0,3) from column B gives me column E.
..offset(0,4) from column A gives me column E.