Hi Howard,

Am Thu, 25 Jun 2015 02:27:26 -0700 (PDT) schrieb L. Howard:

https://www.dropbox.com/s/jyawocfar9...Copy.xlsm?dl=0

that is easier to handle.
Try:

Sub Nme_Find_Exp()
Dim rngFound As Range, Nme As Range
Dim OneRng As Range, rngBig As Range
Dim FirstAddress As String

Set OneRng = Sheets("Input").Range("A2:A" & Cells(Rows.Count,
"A").End(xlUp).Row)

For Each Nme In OneRng

Set rngFound = Sheets("Output").Range("A:A").Find(What:=Nme.Value , _
LookIn:=xlValues, _
LookAt:=xlWhole)


If Not rngFound Is Nothing Then

FirstAddress = rngFound.Address
Do
If rngBig Is Nothing Then
Set rngBig = rngFound.Resize(1, 42)
Else
Set rngBig = Union(rngBig, rngFound.Resize(1, 42))
End If
Set rngFound = Sheets("Output").Range("A:A").FindNext(rngFound)
Loop While Not rngFound Is Nothing And rngFound.Address <
FirstAddress

End If
Next
Sheets("Input").Range("C2").Resize(rngBig.Rows.Cou nt, 42).Value =
rngBig.Value
End Sub


Regards
Claus B.
--
Vista Ultimate / Windows7
Office 2007 Ultimate / 2010 Professional