Hi Howard,

Am Thu, 25 Jun 2015 08:38:15 +0200 schrieb Claus Busch:

If Application.CountA(Nme.Offset(, 1).Resize(1, 41)) = 0 Then
rngFound.Offset(, 1).Resize(1, 41).Copy Nme.Offset(, 1)
Else
rngFound.Resize(1, 42).Copy _
Sheets("Input").Cells(Rows.Count, 1).End(xlUp)(2)
End If

better and faster without copying:

Sub Nme_Find()
Dim rngFound As Range
Dim Nme As Range
Dim OneRng As Range
Dim FirstAddress As String

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

Application.ScreenUpdating = False
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 Application.CountA(Nme.Offset(, 1).Resize(1, 41)) = 0
Then
Nme.Offset(, 1).Resize(1, 41).Value = _
rngFound.Offset(, 1).Resize(1, 41).Value
Else
Sheets("Input").Cells(Rows.Count, 1).End(xlUp)(2). _
Resize(1, 42).Value = rngFound.Resize(1, 42).Value
End If
Set rngFound = Sheets("Output").Range("A:A").FindNext(rngFound)
Loop While Not rngFound Is Nothing And rngFound.Address <
FirstAddress
End If
Next
Application.ScreenUpdating = True
End Sub


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