If Cell in Column C has a number greater than 0 then do this

[pano]

Hi,

I have a problem , if anyone could help.
A worksheet has three columns down to row 14

A-B-C

Row A & B already have values like

COLA COLB COLC
1.Brushes 3 0
2.Gizmos 1 2
3.Bottles 0 1
4.Glasses 0 0

I need a formula which will scan down Column C, C1:C14 and if a cell
has a value greater than zero

Then move rowA2 rowB2 & RowC2 and RowA3 RowB3 & Rowc3 and place them
in row order on another worksheet.

Worksheet2

A B C
Gizmos 1 2
Bottles 0 1

I hope this makes sense, I've tried to explain it the best I could.

Thanks Stephen

 

[CurlyDave]

Give this a go

Dim r As Range
Dim c As Range
Dim ws As Worksheet
Set ws = Worksheets("Sheet1")
Set r = ws.Range("C1", ws.Range("C65536").End(xlUp))
For Each c In r.Cells
If Application.WorksheetFunction.IsNumber(c.Value) Then
If c.Value > 0 Then
c.Rows("1:1").EntireRow.Copy Destination:=Worksheets
("Sheet2").Range("A65536").End(xlUp).Offset(1, 0)
End If
End If
Next c

 

[pano]

CurlyDave
I modified it as follows and when I click on the button to execute
macro it places cells J40 thru to P40 onto worksheet 1a in cells J40
thru to P40.
I need the code to check worksheet sheet1 column P2 downwards to pick
up any cell that has a value in it greater than 0 then select values
that are in the cells N2,O2,P2 downwards and paste them into worksheet
1a in cells E10,F10,G10 downwards. So if P5 has a value greater than 0
N5,O5,P5 have to be pasted into worksheet 1a E11,F11,G11.....

Thanks for your help so far


Sub TEST_Click()
Dim r As Range
Dim p As Range
Dim ws As Worksheet
Set ws = Worksheets("Sheet1")
Set r = ws.Range("p2", ws.Range("C65536").End(xlUp))
For Each p In r.Cells
If Application.WorksheetFunction.IsNumber(p.Value) Then
If p.Value > 0 Then
p.Rows("1:1").EntireRow.Copy Destination:=Worksheets
("1a").Range("A65536").End(xlUp).Offset(1, 0)
End If
End If
Next p
End Sub

 

[CurlyDave]

That's not what your original post describes.
Take a close look at the Code I provided and Your code

My code Loops through column C, when it find the criteria copies the
row and places it in the cell after the last used cell Sheet2 ColumnA
You should have a heading in row 1

 

[pano]

That's not what your original post describes.
Take a close look at  the Code I provided and Your code

My code Loops through column C, when it find the criteria copies the
row and places it in the cell after the last used cell Sheet2 ColumnA
You should have a heading in row 1

Ok Dave, I'm stumped I did it originally as column ABC so it would be
clear and not too confusing as i tried to explain what I needed, I
thought I would be able to modify any code to suit the other columns
that I need, but call me whatever I cant seem to get it to work
properly. Is this where I grovel !!
I've included a link to the workbook in this post if your interested.
http://rapidshare.com/files/194943530/NEW_DWS_TEST0000_-_Copy.xls.html

If you cant help any further, thanks for what you have done.

Regards
Stephen

 

[CurlyDave]

I believe this should do it

Sub bog_Click()
Dim r As Range
Dim p As Range
Dim ws As Worksheet
Set ws = Worksheets("Sheet1")
Set r = ws.Range("P2", ws.Range("P37").End(xlUp))
For Each p In r.Cells
If Application.WorksheetFunction.IsNumber(p.Value) Then
If p.Value > 0 Then
p.Offset(0, -2).Range("A1:C1").Copy
Worksheets("1a").Range("E19").End(xlUp).Offset(1, 0) _
.PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, SkipBlanks _
:=False,
Transpose:=False
End If
End If
Next p
Application.CutCopyMode = False
End Sub

 

[pano]

Dave, been a great help, that macro worked well, however there is
always one however could you have a look at the BIGTEST.xls
http://rapidshare.com/files/195400379/BIGTEST.xls.html

And see if you can adjust the macro you did for these other rows &
columns.?????

A big thanks if you can adjust the macro

 

[Chris Bode via OfficeKB.com]

End If

row = row + 1
Wend
End Sub
#
Have a nice time….


Chris

 

[Chris Bode via OfficeKB.com]

Please follow following steps
1.Right click on the toolbar> click Control Box
2.From the control box that appears on your screen, select a command button
and draw it to your sheet
3.Double click the command button and write following codes in code window
#
Private Sub CommandButton1_Click()
Dim row As Integer, col As Integer

row = 1
col = 1

Dim rowinsheet2 As Integer, colinsheet2 As Integer

rowinsheet2 = 1
colinsheet2 = 1

While Sheet1.Cells(row, col).Value <> ""

If CInt(Sheet1.Cells(row, col + 2).Value) > 0 Then

Sheet2.Cells(rowinsheet2, colinsheet2).Value = Sheet1.Cells
(row, colinsheet2).Value
Sheet2.Cells(rowinsheet2, colinsheet2 + 1).Value = Sheet1.
Cells(row, colinsheet2 + 1).Value
Sheet2.Cells(rowinsheet2, colinsheet2 + 2).Value = Sheet1.
Cells(row, colinsheet2 + 2).Value
rowinsheet2 = rowinsheet2 + 1

End If

row = row + 1
Wend
End Sub
#
Have a nice time….


Chris

 

[Chris Bode via OfficeKB.com]

Sorry for the mistake, please ignore this post, below i have posted the full
code

By Chris bode

 

[pano]

Chris, Totally confused me with your posts...

End If

row = row + 1
Wend
End Sub

this does'nt work wend without while comes up, I gather this is put at
the end of the code???

If it does work but I've misread something could you put it in the
code in the right place? thanks

 

[pano]

DISREGARD SOLVED