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 wrote:
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 macro
below. For some reason, it only results in one hit--seems not to loop
through all the rows. Can anyone show me what I did wrong? or suggest a
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 Sub