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

M

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
 
R

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
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top