Find and copy the row using VBA

[Guest]

Hi,
all

I have a data like this


COlA COlB COlC COLD --------------------------
5-Jun 5-Jul 5-Aug 5-Sep 5-Oct 5-Nov 5-Dec 6-Jan
566.2 676.6 701.1 588.8 623.7 780.4 791.3 479.6
13.7 15 17.5 15.5 12.2 13.7 15.1 9.3
0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0
5 5.9 6.6 5.5 4.1 4 4.8 3.5
0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0
5 5.9 6.6 5.5 4.1 4 4.8 3.5
6.1 6.6 7.4 6.7 5 5.1 5.6 4.8
0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0
6.1 6.6 7.4 6.7 5 5.1 5.6 4.8
1.1 1.1 1.8 1.6 1.6 2.7 2.9 1.1
0 0 0 0 0 1.7 1.4 0
0 0 0 0 0 0 0 0

it's a huge data. I need to find and copy the row in another sheet which
contains the data like this
For four months it's zero and then it has some data. It's usually done for
tracking new product.
0 0 0 0 12.5



any help would be appreciated.

Thanks a lot

 

[Tom Ogilvy]

I assume 4 months was representative and not definitive since none of your
sample data fits that pattern. So I will assume that if the leftmost row is
zero and the rightmost is > 0 then copy the row.

Sub CopyData()
Dim rw as Long, cell as Long
Dim rng as Range
With Worksheets("Sheet1")
set rng = .Range(.Range("A2"),.Range("A2").End(xldown))
End With
rw = 2
for each cell in rng
if cell.Value = 0 and cell.offset(0,7).Value > 0 then
cell.Resize(1,8).copy Destination:=Worksheets("Sheet2") _
.cells(rw,1)
rw = rw + 1
end if
Next
End Sub

--
Regards,
Tom Ogilvy

Hi,
all

I have a data like this


COlA COlB COlC

COLD --------------------------

 

[Guest]

hi,
Tom

thanks a lot

I tried to run the macro but nothing happens
Actually

My first column and row contains some text

e.g
Jun Jul AUg Sep
test 0 0 0 2
ted 0 0 0 2
tid 0 0 0 0

I need to copy test and ted and not tid.
Am I clear now. Could you please help me further?

Thanks a lot

 

[Tom Ogilvy]

Sub CopyData()
Dim rw as Long, cell as Long
Dim rng as Range
With Worksheets("Sheet1")
set rng = .Range(.Range("A2"),.Range("A2").End(xldown))
End With
rw = 2
for each cell in rng

' the 8 below is just a guess from your first sample. there is now
' no reason to believe that actually has any resemblance to your
' true data, so you will have to make you own adjustments

if cell.offset(0,1).Value = 0 and cell.offset(0,8).Value > 0 then
cell.Resize(1,9).copy Destination:=Worksheets("Sheet2") _
.cells(rw,1)
rw = rw + 1
end if
Next
End Sub