Conditional Copy/Paste

[Dan R.]

I'm trying to loop down a column and copy and paste the values to
another wb depending on the cell value. Possibly something like this?

set ws = activesheet
set wb = workbooks.open("c:\file.xls")
set rng = .range(.cells(1, 1), .cells(rows.count, 1).end(xlup))

for each i in rng
select case cells(i, 1)
case "x"
cells(i, 1).copy wb.range("a1").paste
case "y"
cells(i, 1).copy wb.range("b1").paste
case "z"
cells(i, 1).copy wb.range("c1").paste
end select
next

Thanks,
-- Dan

 

[Tom Ogilvy]

Sub ABC()
Dim ws as Worksheet, wb as Worbook
Dim rng as Range, rnga as Range
dim rngb as Range, rngc as Range
Dim cell as Range
set ws = activesheet
set wb = workbooks.open("c:\file.xls")
set rng = ws.range(ws.cells(1, 1), ws.cells(rows.count, 1).end(xlup))

set rnga = wb.Worksheets(1).range("a1")
set rngb = wb.Worksheets(1).range("B1")
set rngc = wb.Worksheets(1).range("c1")
for each cell in rng
select case lcase(cell)
case "x"
cells(i, 1).copy rnga
set rnga = rnga.offset(1,0)
case "y"
cells(i, 1).copy rngb
set rngb = rngb.offset(1,0)
case "z"
cells(i, 1).copy rngc
set rngc = rngc.offset(1,0)
end select
next
end sub

 

[Jim Cone]

Sub PutThemThere()
Dim ws As Worksheet
Dim wb As Workbook
Dim rng As Range
Dim rCell As Range

Set ws = ActiveSheet
Set wb = Workbooks.Open("c:\file.xls")
With ws
Set rng = .Range(.Cells(1, 1), .Cells(.Rows.Count, 1).End(xlUp))
End With

For Each rCell In rng.Cells
Select Case rCell.Value
Case "x"
rCell.Copy wb.Worksheets(1).Range(rCell.Address)
Case "y"
rCell.Copy wb.Worksheets(1).Range(rCell.Address)
Case "z"
rCell.Copy wb.Worksheets(1).Range(rCell.Address)
End Select
Next 'rCell
Set wb = Nothing
Set rng = Nothing
Set rCell = Nothing
Set ws = Nothing
End Sub
--
Jim Cone
San Francisco, USA
http://www.realezsites.com/bus/primitivesoftware



"Dan R." <[email protected]>
wrote in message
I'm trying to loop down a column and copy and paste the values to
another wb depending on the cell value. Possibly something like this?

set ws = activesheet
set wb = workbooks.open("c:\file.xls")
set rng = .range(.cells(1, 1), .cells(rows.count, 1).end(xlup))
for each i in rng
select case cells(i, 1)
case "x"
cells(i, 1).copy wb.range("a1").paste
case "y"
cells(i, 1).copy wb.range("b1").paste
case "z"
cells(i, 1).copy wb.range("c1").paste
end select
next
Thanks,
-- Dan

 

[Dan R.]

Tom,
On yours it didn't like "Cells(i, 1).Copy rnga". Maybe b/c i isn't
defined?

Thanks,
-- Dan

 

[Tom Ogilvy]

ncomplete editing of your original code:

Sub ABC()
Dim ws as Worksheet, wb as Worbook
Dim rng as Range, rnga as Range
dim rngb as Range, rngc as Range
Dim cell as Range
set ws = activesheet
set wb = workbooks.open("c:\file.xls")
set rng = ws.range(ws.cells(1, 1), ws.cells(rows.count, 1).end(xlup))

set rnga = wb.Worksheets(1).range("a1")
set rngb = wb.Worksheets(1).range("B1")
set rngc = wb.Worksheets(1).range("c1")
for each cell in rng
select case lcase(cell)
case "x"
cells(cell, 1).copy rnga
set rnga = rnga.offset(1,0)
case "y"
cells(cell, 1).copy rngb
set rngb = rngb.offset(1,0)
case "z"
cells(cell, 1).copy rngc
set rngc = rngc.offset(1,0)
end select
next
end sub

 

[Dan R.]

Thanks guys,
-- Dan