Sub Macro1()
'
Dim lngA As Long
Dim lngB As Long
Dim varFind
Dim strFirstAddress As String

Worksheets("blad1").Activate
For lngA = 1 To Worksheets("blad1").UsedRange.Rows.Count
lngB = 2
With Worksheets("blad2").UsedRange
Set varFind = .Find(Worksheets("blad1").Cells(lngA, 1).Value,
LookIn:=xlValues)
If Not varFind Is Nothing Then
strFirstAddress = varFind.Address
..Range(varFind.Address).Interior.ColorIndex = 36
Cells(lngA, lngB) = strFirstAddress
lngB = lngB + 1
Set varFind = .FindNext(varFind)
Do While Not varFind Is Nothing And varFind.Address <
strFirstAddress
..Range(varFind.Address).Interior.ColorIndex = 36
Cells(lngA, lngB) = varFind.Address
lngB = lngB + 1
Set varFind = .FindNext(varFind)
Loop
End If
End With
Next lngA
'
End Sub


--
H.A. de Wilde
------------------------------------------------------------------------
H.A. de Wilde's Profile: http://www.excelforum.com/member.php...o&userid=30679
View this thread: http://www.excelforum.com/showthread...hreadid=539087