Thank you. It worked well.

Dave Peterson wrote:
First, if there can be empty cells, I'd use xlup, not xldown:

Option Explicit
Sub CopyIDData()
Dim rng As Range
Dim rng1 As Range
Dim cell As Range
Dim res As Variant

With Worksheets("sheet1")
Set rng = .Range("A1", .cells(.rows.count,"A").end(xlup))
End With

With Worksheets("Sheet2")
Set rng1 = .Range("A1", .cells(.rows.count,"A").end(xlup))
End With

For Each cell In rng.cells
if trim(cell.value) = "" then
'skip it
else
res = Application.Match(cell, rng1, 0)
If Not IsError(res) Then
rng1(res, 2).Resize(1, 1).Copy Destination:=cell.Offset(0, 1)
End If
end if
Next cell
End Sub

(Untested, but it did compile.)

Hello,

[quoted text clipped - 57 lines]
--
Message posted via http://www.officekb.com


--
Message posted via http://www.officekb.com