View Single Post
  #1   Report Post  
Posted to microsoft.public.excel.programming
marlea[_8_] marlea[_8_] is offline
external usenet poster
 
Posts: 1
Default Move some data to new workbook - my attempted macro is no good


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

--
marle
-----------------------------------------------------------------------
marlea's Profile: http://www.excelforum.com/member.php...fo&userid=2620
View this thread: http://www.excelforum.com/showthread.php?threadid=48329