Compare, copy, and paste

[robsimons]

I was reading through some of the other posts and couldn't find exactly what I was looking for. Most were too general for my project.

I have a project that has 2 lists (separate worksheets) that match on 1 column then I would like it to Copy values from Sht1 where the rows match and past on sht2 were the matched row was found. I wrote this:

[VBA]
Sub UpdatesIMP()
Dim rngData As Range
Dim i As Integer
Dim shtName2, shtName3 As String
shtName2 = "Conv v9.2 - New" ' New Values
shtName3 = "DR v9.02 - ORG" ' Orignal (OLD) values
'For DTS comparison based on XREF Number
Set rngData = Sheets(shtName3).Range("F1", Sheets(shtName3).[F1].End(xlDown))
i = 1
For Each cell In rngData.Cells
If Not IsError(Application.Match(cell.Value, Sheets(shtName2).Range("F:F"), 0)) Then
Sheets(shtName3).Range("D" & cell.Row & ":" & "E" & cell.Row).Copy
Sheets(shtName2).Activate
Sheets(shtName2).Range("D" & cell.Row & ":" & "E" & cell.Row).Select
ActiveSheet.Paste
i = i + 1
End If
Next
[/VBA]
It does the matching correctly but I can't get it to exactly get the copy and paste correctly.... The should be more rows in Sht1 than in Sht1 and the sorting is not always the same..

Any ideas? I will also upload the example workbook.

Thanks,
Robert

[mdmackillop]

Try Find
[VBA]
Option Explicit
Sub UpdatesIMP()
Dim rngData As Range, cel As Range, c As Range
Dim i As Integer
Dim shtName2, shtName3 As String
shtName2 = "Conv v9.2 - New" ' New Values
shtName3 = "DR v9.02 - ORG" ' Orignal (OLD) values
'For DTS comparison based on XREF Number
With Sheets(shtName3)
Set rngData = Range(.Range("F2"), .Range("F2").End(xlDown))
End With
For Each cel In rngData
Set c = Sheets(shtName2).Range("F:F").Find(cel.Text, lookat:=xlWhole)
If Not c Is Nothing Then
cel.Offset(, -4).Resize(, 2).Copy c.Offset(, -4)
End If
Next
End Sub

[/VBA]

[robsimons]

this works great thanks for the help!!!!