Attribute VB_Name = "McRitchie_Arrays"
Option Explicit
'-- Documented in http://www.mvps.org/dmcritchie/excel/arrays.htm
'-- 2003-09-01 David McRitchie
Dim arrCopyto()
Sub CopyToArray()
'-- Documented in http://www.mvps.org/dmcritchie/excel/arrays.htm
'-- 2003-09-01 David McRitchie
   Dim I As Long, j As Long, n As Long, cell As Range
   n = 0   'picks up values from multiple areas
   ReDim arrCopyto(0 To 1)  'no Preserve so starts fresh
   For I = 1 To Selection.Areas.Count
      On Error Resume Next   'in case nothing in selection
      For Each cell In Intersect(Selection.Areas(I), _
         Cells.SpecialCells(xlConstants, xlTextValues))
        n = n + 1  '-- Note use of Preserve --
        ReDim Preserve arrCopyto(0 To n)
        arrCopyto(n) = cell.Value
      Next
      On Error GoTo 0
   Next
   arrCopyto(0) = n
End Sub

Sub PasteFromArray()
  Dim I As Long
  '-- Not limited to selection, will continue down using width
  '-- of selection,  which is what I really wanted
  For I = 1 To UBound(arrCopyto)
     Selection.Item(I) = arrCopyto(I)
  Next I
done:   Exit Sub
End Sub
Sub PasteFromArray_Limited()
  Dim I As Long
  '-- Limited to Selection
  For I = 1 To Application.Min(UBound(arrCopyto), Selection.Count)
     Selection.Item(I) = arrCopyto(I)
  Next I
done:   Exit Sub
End Sub