Move some data to new workbook - my attempted macro is no good

[marlea]

Hi-

I want to move columns of data between two workbooks as listed below.

Source file = "source_life06.xls" ; Destination file = "paste.xls"

Source --> Destination
D --> P
E --> Q
F --> F
K --> L
Y --> I

Based on past help I've rcvd in this forum, I pieced together the macr
below. For some reason, it only results in one hit--seems not to loo
through all the rows. Can anyone show me what I did wrong? or suggest
better approach? Thanks!

Sub Macro1()
Dim rng1 As Range, cell As Range
Dim bk1 As Workbook, bk2 As Workbook
Dim sh1 As Worksheet, sh2 As Worksheet
Set bk1 = Workbooks("source_life06.xls")
Set bk2 = Workbooks("paste.xls")
Set sh1 = bk1.Worksheets(1)
Set sh2 = bk2.Worksheets(1)
Set rng1 = sh1.Range(sh1.Cells(2, 1), sh1.Cells(2, 1).End(xlDown))

Dim pgStart, pgEnd As Integer
Dim title, pointer, contentNo As String

For Each cell In rng1

rw = 2

sh1.Activate
ActiveSheet.Range("A2").Select

'Get page start
pgStart = ActiveCell.Offset(0, 3).Value

'Get page end
pgEnd = ActiveCell.Offset(0, 4).Value

'Get title
title = ActiveCell.Offset(0, 5).Value

'Get pointer
pointer = ActiveCell.Offset(0, 10).Value

'Get content number
contentNo = ActiveCell.Offset(0, 24).Value

sh2.Cells(rw, 16).Value = pgStart
sh2.Cells(rw, 17).Value = pgEnd
sh2.Cells(rw, 6).Value = title
sh2.Cells(rw, 12).Value = pointer
sh2.Cells(rw, 9).Value = contentNo

Next

sh2.Activate
ActiveSheet.Range("A1").Select
End Su

 

[Rowan Drummond]

Hi Marlea

Two things that stand out. The first is that you are looping for each
Cell in the range but always setting your variables based on the
activecell - which is not changing so

pgStart = ActiveCell.Offset(0, 3).Value
should be
pgStart = Cell.Offset(0, 3).Value

and
pgEnd = ActiveCell.Offset(0, 4).Value
should be
pgEnd = Cell.Offset(0, 4).Value
etc

Secondly you never increase the value of rw so every paste will be into
the same row of the target workbook. You need to add 1 to rw each time
you loop eg:

<snip>
sh2.Cells(rw, 9).Value = contentNo
rw = rw + 1
Next
<snip>

Hope this helps
Rowan

 

[marlea]

Thanks, Rowan! It's working now, yay!

 

[Rowan Drummond]

You're welcome.