Copy columns if cell row has a value

[christian]

* Need to read each row in a spreasheet (number of rows in the
spreadsheet will always be changing)

* if there is a value in Cells(i, 4) and
the text in Cells(i, 3) = 'Active'

I want to copy columns 1,4,5,7,10 to a new workbook. [one or more row
makes up one record - the value in column 4 signifies a new record]

* This new spreadsheet will be turned into a CSV to feed another
program.


How would you approach this?
Any help is appreciated!!
thanks
-christia

 

[Tom Ogilvy]

Dim rng as Range, rw as long, dest as Range
Dim cell as Range
with Activesheet
set rng = Intersect(.columns(1),.usedrange).Cells
End with
set dest = workbooks("Otherbook.xls").Worksheets(1).Range("A1")
rw = 0
for each cell in rng
if cell.offset(0,3) <> "" and cell.offset(0,2)="Active" then
rw = rw + 1
cell.Range("A1,A4,A5,A7,A10").copy Destination:=dest(rw)
End if
Next

 

[christian]

Thanks - got me 90% there. For some reason I'm only getting the first
column though...4,5,7,10 don't get copied over.

Tried to figure it out on my own but pulling what little hair I have
left out. I'm not sure I understand the use of ("A1,A4,A5...") - does
"A" constitute the ROW and 1,4,5 the Column?

Thanks again - HUGE help!!!
-c

 

[Tom Ogilvy]

Sorry, got my rows and columns reversed. This works
Sub BBBB()
Dim rng As Range, rw As Long, dest As Range
Dim cell As Range
With ActiveSheet
Set rng = Intersect(.Columns(1), .UsedRange).Cells
End With
Set dest = Workbooks("Otherbook.xls").Worksheets(1).Range("A1")
rw = 0
For Each cell In rng
If cell.Offset(0, 3) <> "" And cell.Offset(0, 2) = "Active" Then
rw = rw + 1
cell.Range("A1,D1,E1,G1,J1").Copy Destination:=dest(rw)
End If
Next
End Sub


so cell.Range("A1,D1,E1,G1,J1").

is relative to the cell where it is anchored. co Cell.Range("D1") would be
column D (column 4) since cell is in column A.