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