Home page:
[View without Frames]

Copy Multiple Areas to a single dimensioned array

Created this to pull out some sample data from multiple areas of a workbook and paste them into a single area.  Note use of PRESERVE to retain current values when redimensioning an array. The first REDIM does not include PRESERVE.  The lifetime of the array arrCopyto is for as long as the workbook is open.
Option Explicit
Dim arrCopyto()
Sub CopyToArray()
   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
      On Error GoTo 0
   arrCopyto(0) = n
End Sub
To "paste" the array back to your worksheet, you can choose one of the following macros.
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


This page was introduced on September 01, 2003. 

[My Excel Pages -- home]    [INDEX to my site and the off-site pages I reference] 
[Site Search -- Excel]     [Go Back]    [Return to TOP

Please send your comments concerning this web page to: David McRitchie send email comments

Copyright © 1997 - 2004,  F. David McRitchie,  All Rights Reserved