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

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

--
Regards,
Tom Ogilvy


"Dan R." wrote:

> 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
>
>

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." <(E-Mail Removed)>
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

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

Thanks,
-- Dan

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

--
Regards,
Tom Ogilvy


"Dan R." wrote:

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

Thanks guys,
-- Dan