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

Hi
Tom
Thanx a lot It worked great.
I wanted to ask one more question.
MY output is coming like this
123
134
145

in sheet1

But I want my output to come like this
A1 B1 C1
123 134 145

If you could help me on that that would be really great

Thanx again in advance

"Tom Ogilvy" wrote:

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

Dim Rng As Range, Rng1 as Range
Dim rng2 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
set rng2 = Worksheets("Sheet1").Cells(rows.count,1).End(xlup) (2)
Range(Rng,rng1).Offset(0, 1).Copy
rng2.Pastespecial xlPasteAll, Transpose:=True
End If

--
Regards,
Tom Ogilvy


"Lolly" wrote in message
...
Hi
Tom
Thanx a lot It worked great.
I wanted to ask one more question.
MY output is coming like this
123
134
145

in sheet1

But I want my output to come like this
A1 B1 C1
123 134 145

If you could help me on that that would be really great

Thanx again in advance

"Tom Ogilvy" wrote:

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

Tom,

The thing I like about your responses is that they work with very little
modification for a variet of circumstances.

Thanks for all of your contributions.

Mike

"Tom Ogilvy" wrote:

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