Copying Data Another Try

[Gazza]

I want to be able to copy a range of non-continuous cells from one work book
to another one. A colleague of mine has come up with the following code
which eclares the two ranges as arrays. I want to be able to modify the code
so that I can copy about 50 cells from one book to the other - Can anyone
suggest an easier way of doing this?

Option Explicit
'
'

' specify your Source & Destination workbooks & worksheets in this section
' the number of cells to copy -1
' the source & destination cells in the 2 arrays

'Source workbook & sheet
Const SOURCE_Sheet = "Sheet1"
Const SOURCE_Workbook = "book1.xls"

'Destination workbook & sheet
Const DEST_Sheet = "Sheet2"
Const DEST_Workbook = "C:\Shared Documents/book2"
Const SAVE_book = "Book2.xls"

Const CopyCells = 10 'no of cells to copy


Sub Copy()

Dim DataSource 'cell locations of data to move
Dim DataDest 'cell destinations
Dim Data(0 To CopyCells) 'array holding value of data in cells
Dim element As Integer 'array element pointer

Application.ScreenUpdating = False

'location of cells to copy
DataSource = Array("A1", "A2", "A3", "A4", "A5", "A7", "A9", "A11",
"A15", "A19", "A20")
'location of cells to copy into
DataDest = Array("B2", "E2", "D4", "F6", "B6", "A7", "A9", "C11", "C1",
"D1", "E8")


'read data into array
For element = 0 To CopyCells
Data(element) = Worksheets(SOURCE_Sheet).Range(DataSource(element))
Next element

'Open Destination Workbook at correct sheet NOT in a seperate taskbar
Application.ShowWindowsInTaskbar = False
Workbooks.Open Filename:=DEST_Workbook
Worksheets(DEST_Sheet).Select


'copy data into Destination worksheet
For element = 0 To CopyCells
Worksheets(DEST_Sheet).Range(DataDest(element)) = Data(element)
Next element

'return to Source book
Windows(SOURCE_Workbook).Activate
Workbooks(SAVE_book).Close savechanges:=True

End Sub

 

[Tom Ogilvy]

If there is no pattern, then listing the source cells and the destination
cells would be required and the code shown would just be expanded to list
each in the array.

 

[Gazza]

Appreciate that I need an array but rather than list the cells in the module
would it be possible to list these on say a spare worksheet and have the
code loop through the cells passing the cell reference each time?

Have a feeling that if this was possible it would be easier to set the array
up and make any changes should these arise.

 

[PY & Associates]

Very close now.
We are standing by, and learning.

 

[Tom Ogilvy]

Assume your list of source and corresponding destination cells is on a sheet
named CellList in the workbook containing the code.

Source list starts in A1 and is in column 1 (A)
Destination list starts in B1 and is column 2 (B)

Option Explicit
Option Base 0
'
'

' specify your Source & Destination workbooks & worksheets in this section
' the number of cells to copy -1
' the source & destination cells in the 2 arrays

'Source workbook & sheet
Const SOURCE_Sheet = "Sheet1"
Const SOURCE_Workbook = "book1.xls"

'Destination workbook & sheet
Const DEST_Sheet = "Sheet2"
Const DEST_Workbook = "C:\Shared Documents/book2.xls"
Const SAVE_book = "Book2.xls"



Sub Copy()

Dim DataSource 'cell locations of data to move
Dim DataDest 'cell destinations
Dim Data() 'array holding value of data in cells
Dim element As Integer 'array element pointer
Dim rng as Range 'cells holding source list
Dim CopyCells as Long 'no of cells to copy

Application.ScreenUpdating = False

With Worksheets("CellList")
set rng = .Range(.Cells(1,1),.Cells(1,1).End(xldown)).Value
End With

CopyCells = rng.rows.count

Redim Data(1 to CopyCells)

'location of cells to copy
DataSource = rng.Value

'location of cells to copy into
DataDest = rng.offset(0,1).Value

'read data into array
For element = 1 To CopyCells
Data(element) =
Worksheets(SOURCE_Sheet).Range(DataSource(element,1))
Next element

'Open Destination Workbook at correct sheet
'Application.ShowWindowsInTaskbar = False
Workbooks.Open Filename:=DEST_Workbook
Worksheets(DEST_Sheet).Select


'copy data into Destination worksheet
For element = 0 To CopyCells
Worksheets(DEST_Sheet).Range(DataDest(element,1)) = Data(element)
Next element

'return to Source book
Windows(SOURCE_Workbook).Activate
Workbooks(SAVE_book).Close savechanges:=True

End Sub