Dim Rng As Range, Rng1 as Range
Application.Worksheets("Sheet3").Select
Set Rng = Range("data").Find(What:="31", LookAt:=xlWhole, LookIn:=xlValues)
If Rng Is Nothing Then
MsgBox "Data Not Found"
Exit Sub
Else
set rng1 = rng
do while rng1.offset(1,0).Value = 31
set rng1 = rng1.offset(1,0)
Loop
Range(Rng,rng1).Offset(0, 1).Copy _
Destination:=Application.Worksheets("Sheet1").Rang e("A2")
End If

--
Regards,
Tom Ogilvy


"Lolly" wrote in message
...
My SourceData looks as follows

Measure Value


31 132
31 135
34 123
34 124
35 235

My code looks like this

Dim Rng As Range
Application.Worksheets("Sheet3").Select
Set Rng = Range("data").Find(What:="31", LookAt:=xlWhole,
LookIn:=xlValues)
If Rng Is Nothing Then
MsgBox "Data Not Found"
Exit Sub
Else
Rng.Offset(0, 1).Copy
Destination:=Application.Worksheets("Sheet1").Rang e("A2")
End If


This copies only first value of 31 in the sheet1. I want to copy all the
values corresponding to 31
In sheet1

Data should look like this

132 135 ...Till the last Occurence of value 31 is there it needs to be
copied to sheet1

If anyone could help me urgently

Thanx








--
Kittie