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

[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

 

[GS]

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

 

[joeu2004]

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?

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

 

[Howard]

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

Thanks, Garry.

Pretty slick!

Appreciate it.

Regards,
Howard

 

[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

Thanks joeu2004.

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

Many thanks.

Regards,
Howard

 

[GS]

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