One trick in this exercise is that it is not necessary to check an
values - just replace the data. This saves a couple of lines of code
and therefore saves process time over large numbers of records.

I have also found that Copy/Paste is faster than writing values t
cells. This code adds the "new" record to the bottom of the data if i
cannot find a match.

'---------------------------------------------------------
Sub transfer_data()
Dim FromSheet As Worksheet
Dim ToSheet As Worksheet
Dim FoundCell As Object
Dim FromRow As Long
Dim ToRow As Long
Dim LastRow As Long
Dim FindValue
Dim PasteRange As Range
'--------------------------
Application.Calculation = xlCalculationManual
Set FromSheet = ActiveSheet
Set ToSheet = Workbooks("Book1.xls").Worksheets("data")
LastRow = ToSheet.Range("A65536").End(xlUp).Row + 1
FromRow = 2
While FromSheet.Cells(FromRow, 1).Value < ""
' find record
FindValue = FromSheet.Cells(FromRow, 1).Value
FromSheet.Range("A" & FromRow & ":H" & FromRow).Copy
Set FoundCell = ToSheet.Columns(1).Find(what:=FindValue)
If FoundCell Is Nothing Then
' add data to bottom of list
Set PasteRange = ToSheet.Range("A" & LastRow)
LastRow = LastRow + 1
Else
' replace data
ToRow = FoundCell.Row
Set PasteRange = ToSheet.Range("A" & ToRow)
End If
ToSheet.Paste Destination:=PasteRange
FromRow = FromRow + 1
Wend
Application.Calculation = xlCalculationAutomatic
MsgBox ("Done")
End Sub
'---------------------------------------------------------------

--
Message posted from http://www.ExcelForum.com