Help with copy/paste based on criteria

[Jayhawktc]

I am needing to copy and past certain cells in a row based on the valu
of another column.
If a cell in column R is greater than Zero then I need to copy cells i
Column A, C, E, G, K, R, T, and W that are in the same row as the cel
from column R that was greater than zero.
Example:
If cell R7 is greater than zero then copy A7, C7, E7, G7, K7, R7, T
and W7 then paste in sheet "summary".
I can write code to point it to a specific cell and then copy the cell
in that row but I do not know how to make it look at the whole column
and repeat that copy and paste each time it finds a cell in column
with a value greater than zero. Any help would be greatly appreciated
Thanks in advance

 

[Frank Kabel]

Hi
have a look at
http://www.rondebruin.nl/copy5.htm
as a starting point

 

[Tom Ogilvy]

The easiest way would be to use an autofilter to make only the appropriate
rows visible, then copy all at once.

Assume your data is set up like a database with headers in row1 and you
don't have any completely blank rows or columns from A to W and from row 2
to the end of the data.

Sub CopyData()
Dim sh As Worksheet, sh1 As Worksheet
Dim rng As Range, rng1 As Range
Dim rng2 As Range
Set sh = Worksheets("Data")
Set sh1 = Worksheets("Sheet2")
If sh.AutoFilterMode Then
sh.ShowAllData
End If
sh.Range("A1").AutoFilter _
Field:=18, Criteria1:=">0"
With sh.AutoFilter.Range
Set rng = .Offset(1, 0).Resize(.Rows.Count - 1)
End With
On Error Resume Next
Set rng3 = rng.SpecialCells(xlVisible)
On Error GoTo 0
If Not rng3 Is Nothing Then
Set rng1 = sh.Range("A:A,C:C,E:E,G:G,K:K,R:R,T:T,W:W")
Set rng2 = Intersect(rng3, rng1)
rng2.Copy sh1.Cells(Rows.Count, 1).End(xlUp)(2)
End If
End Sub