Copy .Areas.Item(1,2,3,4,5, etc.) to a column or a row

  • Thread starter Thread starter Howard
  • Start date Start date
H

Howard

This little snippet does a good job of taking the non-contiguous
selected cells in named range "Fivex" and putting them in the same address on sheet 2.

How can I take the non-contiguous selected cells and list them in a column OR a row?

The commented out line renders the last selected cell in the area to the range M1.

Regards,
Howard

Option Explicit

Sub copyrng()
Dim i As Long
Dim Fivex As Range
With ActiveSheet.Range("Fivex")
For i = 1 To .Areas.Count
'.Areas.Item(i).Copy Sheets("sheet2").Range("M1")
.Areas(i).Copy Sheets("sheet2").Range(.Areas(i).Address)
Next
End With
End Sub
 
Basically, you need to loop each area and put the value into an output
array that you can dump back into your sheet to a row or col as
desired.

Try...

Sub CopyAreas()
Dim vAreas, vData, n&, j&, sVals$
vAreas = Split(Selection.Address, ",")
For n = LBound(vAreas) To UBound(vAreas)
vData = Range(vAreas(n))
If Not IsArray(vData) Then '//single cell
sVals = sVals & "~" & vData
Else
For j = LBound(vData) To UBound(vData)
sVals = sVals & "~" & vData(j, 1)
Next 'j
End If 'Not IsArray(vData)
Next 'n
vData = Split(Mid(sVals, 2), "~")
'Resize the target range and dump the data
'To col
Range("M1").Resize(UBound(vData) + 1, 1) = _
Application.Transpose(vData)
'To row
Range("M1").Resize(1, UBound(vData) + 1) = vData
End Sub

--
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion
 
Howard said:
This little snippet does a good job of taking the non-contiguous
selected cells in named range "Fivex" and putting them in the same
address on sheet 2.
How can I take the non-contiguous selected cells and list them in
a column OR a row?
Click to expand...

One way....

Option Explicit

Sub doit()
Dim src As Range, dst As Range
Dim n As Long
With Application
.ScreenUpdating = False
.Calculation = xlCalculationManual
.EnableEvents = False
End With
Set dst = Sheet2.Range("a2")
n = 0
For Each src In Range("fivex")
n = n + 1
src.Copy dst(n)
Next
dst(n).EntireColumn.AutoFit ' optional
With Application
.EnableEvents = True
.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
End With
End Sub


But copy-and-paste is needed only if you want to copy formats as well as
values.

Also, beware that when copy-and-pasting formulas, Excel might try to change
them. The result might not be copacetic with their new arrangement.

If you just want to copy values, replace ``src.Copy dst(n)`` with
dst(n)=src.

If you want to copy values and just numeric formats (not also conditional
formats, for example), replace ``src.Copy dst(n)`` with:

With dst(n)
.Value = src
.NumberFormat = src.NumberFormat
End With

Alternatively, the following copies just values more quickly.

Option Explicit

Sub doit2()
Dim src As Range, dst As Range
Dim n As Long
With Application
.ScreenUpdating = False
.Calculation = xlCalculationManual
.EnableEvents = False
End With
Set dst = Sheet2.Range("a2")
ReDim v(1 To Range("fivex").Count, 1 To 1)
n = 0
For Each src In Range("fivex")
n = n + 1
v(n, 1) = src
Next
With dst
.Resize(n) = v
.EntireColumn.AutoFit
End With
With Application
.EnableEvents = True
.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
End With
End Sub
 
Basically, you need to loop each area and put the value into an output

array that you can dump back into your sheet to a row or col as

desired.



Try...



Sub CopyAreas()

Dim vAreas, vData, n&, j&, sVals$

vAreas = Split(Selection.Address, ",")

For n = LBound(vAreas) To UBound(vAreas)

vData = Range(vAreas(n))

If Not IsArray(vData) Then '//single cell

sVals = sVals & "~" & vData

Else

For j = LBound(vData) To UBound(vData)

sVals = sVals & "~" & vData(j, 1)

Next 'j

End If 'Not IsArray(vData)

Next 'n

vData = Split(Mid(sVals, 2), "~")

'Resize the target range and dump the data

'To col

Range("M1").Resize(UBound(vData) + 1, 1) = _

Application.Transpose(vData)

'To row

Range("M1").Resize(1, UBound(vData) + 1) = vData

End Sub
Click to expand...


Thanks, Garry.

Pretty slick!

Appreciate it.

Regards,
Howard
 
One way....



Option Explicit



Sub doit()

Dim src As Range, dst As Range

Dim n As Long

With Application

.ScreenUpdating = False

.Calculation = xlCalculationManual

.EnableEvents = False

End With

Set dst = Sheet2.Range("a2")

n = 0

For Each src In Range("fivex")

n = n + 1

src.Copy dst(n)

Next

dst(n).EntireColumn.AutoFit ' optional

With Application

.EnableEvents = True

.Calculation = xlCalculationAutomatic

.ScreenUpdating = True

End With

End Sub





But copy-and-paste is needed only if you want to copy formats as well as

values.



Also, beware that when copy-and-pasting formulas, Excel might try to change

them. The result might not be copacetic with their new arrangement.



If you just want to copy values, replace ``src.Copy dst(n)`` with

dst(n)=src.



If you want to copy values and just numeric formats (not also conditional

formats, for example), replace ``src.Copy dst(n)`` with:



With dst(n)

.Value = src

.NumberFormat = src.NumberFormat

End With



Alternatively, the following copies just values more quickly.



Option Explicit



Sub doit2()

Dim src As Range, dst As Range

Dim n As Long

With Application

.ScreenUpdating = False

.Calculation = xlCalculationManual

.EnableEvents = False

End With

Set dst = Sheet2.Range("a2")

ReDim v(1 To Range("fivex").Count, 1 To 1)

n = 0

For Each src In Range("fivex")

n = n + 1

v(n, 1) = src

Next

With dst

.Resize(n) = v

.EntireColumn.AutoFit

End With

With Application

.EnableEvents = True

.Calculation = xlCalculationAutomatic

.ScreenUpdating = True

End With

End Sub
Click to expand...

Thanks joeu2004.

Works well also, I will play with the options you submited.

Many thanks.

Regards,
Howard
 
Note that my suggestion is only an example of how to deal with areas
individually, assuming selection in individual cols. It would need to
be modified slightly to deal with a defined name non-contiguous range
so it works with its area addresses rather than selection address.

Also, provision must be added to include multi-col areas if
UBound(vData, 2) is greater than 1!

--
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion
 
Back
Top