I am trying to copy a combination of a small contiguous range along with one
non-contiguous cell. The Selection.Copy command I am using is returning a
"That command cannot be used on multiple selections". I have not been able to
find the command that will do this. The related code I am using is below:

Sheets("sheet1").Activate
Set r1 = Range("B2:B8")
Set r2 = Range("E1:E1")
Set myMultiAreaRange = Union(r1, r2)
myMultiAreaRange.Select
MsgBox (myMultiAreaRange.Address)
Selection.Copy

Ideas??

Thanks!

If the ranges are the same size then the selection will copy...
Set r1 = Range("B2:B8")
Set r2 = Range("E2:E8")
Otherwise, I believe you are stuck with copying and pasting the
individual areas.
--
Jim Cone
San Francisco, USA
http://www.realezsites.com/bus/primitivesoftware
(Excel Add-ins / Excel Programming)



"greyhound girl"

wrote in message
I am trying to copy a combination of a small contiguous range along with one
non-contiguous cell. The Selection.Copy command I am using is returning a
"That command cannot be used on multiple selections". I have not been able to
find the command that will do this. The related code I am using is below:

Sheets("sheet1").Activate
Set r1 = Range("B2:B8")
Set r2 = Range("E1:E1")
Set myMultiAreaRange = Union(r1, r2)
myMultiAreaRange.Select
MsgBox (myMultiAreaRange.Address)
Selection.Copy

Ideas??
Thanks!

You can't copy that range in interactive Excel, nor in VBA.
Just copy each range individually, but you can do so without selecting them

Range("B2:B8").Copy

and if you know where it's going to go, a single command will do that, too

Range("B2:B8").Copy range("C9")

copies your first range to a range beginning with cell C9

"greyhound girl" wrote:

I am trying to copy a combination of a small contiguous range along with one
non-contiguous cell. The Selection.Copy command I am using is returning a
"That command cannot be used on multiple selections". I have not been able to
find the command that will do this. The related code I am using is below:

Sheets("sheet1").Activate
Set r1 = Range("B2:B8")
Set r2 = Range("E1:E1")
Set myMultiAreaRange = Union(r1, r2)
myMultiAreaRange.Select
MsgBox (myMultiAreaRange.Address)
Selection.Copy

Ideas??

Thanks!

*sigh* ... guess I'll have to do it with individual copy and paste. Thanks
though!

"Jim Cone" wrote:


If the ranges are the same size then the selection will copy...
Set r1 = Range("B2:B8")
Set r2 = Range("E2:E8")
Otherwise, I believe you are stuck with copying and pasting the
individual areas.
--
Jim Cone
San Francisco, USA
http://www.realezsites.com/bus/primitivesoftware
(Excel Add-ins / Excel Programming)



"greyhound girl"

wrote in message
I am trying to copy a combination of a small contiguous range along with one
non-contiguous cell. The Selection.Copy command I am using is returning a
"That command cannot be used on multiple selections". I have not been able to
find the command that will do this. The related code I am using is below:

Sheets("sheet1").Activate
Set r1 = Range("B2:B8")
Set r2 = Range("E1:E1")
Set myMultiAreaRange = Union(r1, r2)
myMultiAreaRange.Select
MsgBox (myMultiAreaRange.Address)
Selection.Copy

Ideas??
Thanks!

Thanks. Looks like I will have to do some individual copying and pasting but
it's nice to know there isn't some snazzy little method out there I could use
instead. I want waste time looking.

"Duke Carey" wrote:

You can't copy that range in interactive Excel, nor in VBA.
Just copy each range individually, but you can do so without selecting them

Range("B2:B8").Copy

and if you know where it's going to go, a single command will do that, too

Range("B2:B8").Copy range("C9")

copies your first range to a range beginning with cell C9

"greyhound girl" wrote:

I am trying to copy a combination of a small contiguous range along with one
non-contiguous cell. The Selection.Copy command I am using is returning a
"That command cannot be used on multiple selections". I have not been able to
find the command that will do this. The related code I am using is below:

Sheets("sheet1").Activate
Set r1 = Range("B2:B8")
Set r2 = Range("E1:E1")
Set myMultiAreaRange = Union(r1, r2)
myMultiAreaRange.Select
MsgBox (myMultiAreaRange.Address)
Selection.Copy

Ideas??

Thanks!

On Jul 27, 10:08 am, greyhound girl
wrote:
Thanks. Looks like I will have to do some individual copying and pasting but
it's nice to know there isn't some snazzy little method out there I could use
instead. I want waste time looking.

"Duke Carey" wrote:
You can't copy that range in interactive Excel, nor in VBA.
Just copy each range individually, but you can do so without selecting them

Range("B2:B8").Copy

and if you know where it's going to go, a single command will do that, too

Range("B2:B8").Copy range("C9")

copies your first range to a range beginning with cell C9

"greyhound girl" wrote:

I am trying to copy a combination of a small contiguous range along with one
non-contiguous cell. The Selection.Copy command I am using is returning a
"That command cannot be used on multiple selections". I have not been able to
find the command that will do this. The related code I am using is below:

Sheets("sheet1").Activate
Set r1 = Range("B2:B8")
Set r2 = Range("E1:E1")
Set myMultiAreaRange = Union(r1, r2)
myMultiAreaRange.Select
MsgBox (myMultiAreaRange.Address)
Selection.Copy

Ideas??

Thanks!

I found this macro on John Walkenbach's site a couple of months ago,
and adapted it to my own needs as an add-in, it allows the user to
select non contiguous ranges of cells, and paste them back to any
worksheet in the workbook. I know that you're after a macro doing
this, but maybe it will help. I hope so.

Sub CopyMultipleSelection()
'Gets around Excel's default behaviour of not allowing a copy to
'clipboard of non-contiguous ranges


Dim SelAreas() As Range
Dim PasteRange As Range
Dim UpperLeft As Range
Dim NumAreas As Integer, i As Integer
Dim TopRow As Long, LeftCol As Integer
Dim RowOffset As Long, ColOffset As Integer
Dim NonEmptyCellCount As Integer

' Exit if a range is not selected
If TypeName(Selection) < "Range" Then
MsgBox "Select the range to be copied. A multiple selection is
allowed."
Exit Sub
End If

' Store the areas as separate Range objects
NumAreas = Selection.Areas.Count
ReDim SelAreas(1 To NumAreas)
For i = 1 To NumAreas
Set SelAreas(i) = Selection.Areas(i)
Next

' Determine the upper left cell in the multiple selection
TopRow = ActiveSheet.Rows.Count
LeftCol = ActiveSheet.Columns.Count
For i = 1 To NumAreas
If SelAreas(i).Row < TopRow Then TopRow = SelAreas(i).Row
If SelAreas(i).Column < LeftCol Then LeftCol =
SelAreas(i).Column
Next
Set UpperLeft = Cells(TopRow, LeftCol)

' Get the paste address
On Error Resume Next
Set PasteRange = Application.InputBox _
(prompt:="Specify the upper left cell for the paste range:", _
Title:="Copy Mutliple Selection", _
Type:=8)
On Error GoTo 0
' Exit if canceled
If TypeName(PasteRange) < "Range" Then Exit Sub

' Make sure only the upper left cell is used
Set PasteRange = PasteRange.Range("A1")

' Check paste range for existing data
NonEmptyCellCount = 0
For i = 1 To NumAreas
RowOffset = SelAreas(i).Row - TopRow
ColOffset = SelAreas(i).Column - LeftCol
NonEmptyCellCount = NonEmptyCellCount + _
Application.CountA(Range(PasteRange.Offset(RowOffs et,
ColOffset), _
PasteRange.Offset(RowOffset + SelAreas(i).Rows.Count - 1,
_
ColOffset + SelAreas(i).Columns.Count - 1)))
Next i

' If paste range is not empty, warn user
If NonEmptyCellCount < 0 Then _
If MsgBox("Overwrite existing data?", vbQuestion + vbYesNo, _
"Copy Multiple Selection") < vbYes Then Exit Sub

' Copy and paste each area
For i = 1 To NumAreas
RowOffset = SelAreas(i).Row - TopRow
ColOffset = SelAreas(i).Column - LeftCol
SelAreas(i).Copy PasteRange.Offset(RowOffset, ColOffset)
Next i

End Sub

Cheers!

On Jul 27, 11:16 am, Limey wrote:
On Jul 27, 10:08 am, greyhound girl



wrote:
Thanks. Looks like I will have to do some individual copying and pasting but
it's nice to know there isn't some snazzy little method out there I could use
instead. I want waste time looking.

"Duke Carey" wrote:
You can't copy that range in interactive Excel, nor in VBA.
Just copy each range individually, but you can do so without selecting them

Range("B2:B8").Copy

and if you know where it's going to go, a single command will do that, too

Range("B2:B8").Copy range("C9")

copies your first range to a range beginning with cell C9

"greyhound girl" wrote:

I am trying to copy a combination of a small contiguous range along with one
non-contiguous cell. The Selection.Copy command I am using is returning a
"That command cannot be used on multiple selections". I have not been able to
find the command that will do this. The related code I am using is below:

Sheets("sheet1").Activate
Set r1 = Range("B2:B8")
Set r2 = Range("E1:E1")
Set myMultiAreaRange = Union(r1, r2)
myMultiAreaRange.Select
MsgBox (myMultiAreaRange.Address)
Selection.Copy

Ideas??

Thanks!

I found this macro on John Walkenbach's site a couple of months ago,
and adapted it to my own needs as an add-in, it allows the user to
select non contiguous ranges of cells, and paste them back to any
worksheet in the workbook. I know that you're after a macro doing
this, but maybe it will help. I hope so.

Sub CopyMultipleSelection()
'Gets around Excel's default behaviour of not allowing a copy to
'clipboard of non-contiguous ranges

Dim SelAreas() As Range
Dim PasteRange As Range
Dim UpperLeft As Range
Dim NumAreas As Integer, i As Integer
Dim TopRow As Long, LeftCol As Integer
Dim RowOffset As Long, ColOffset As Integer
Dim NonEmptyCellCount As Integer

' Exit if a range is not selected
If TypeName(Selection) < "Range" Then
MsgBox "Select the range to be copied. A multiple selection is
allowed."
Exit Sub
End If

' Store the areas as separate Range objects
NumAreas = Selection.Areas.Count
ReDim SelAreas(1 To NumAreas)
For i = 1 To NumAreas
Set SelAreas(i) = Selection.Areas(i)
Next

' Determine the upper left cell in the multiple selection
TopRow = ActiveSheet.Rows.Count
LeftCol = ActiveSheet.Columns.Count
For i = 1 To NumAreas
If SelAreas(i).Row < TopRow Then TopRow = SelAreas(i).Row
If SelAreas(i).Column < LeftCol Then LeftCol =
SelAreas(i).Column
Next
Set UpperLeft = Cells(TopRow, LeftCol)

' Get the paste address
On Error Resume Next
Set PasteRange = Application.InputBox _
(prompt:="Specify the upper left cell for the paste range:", _
Title:="Copy Mutliple Selection", _
Type:=8)
On Error GoTo 0
' Exit if canceled
If TypeName(PasteRange) < "Range" Then Exit Sub

' Make sure only the upper left cell is used
Set PasteRange = PasteRange.Range("A1")

' Check paste range for existing data
NonEmptyCellCount = 0
For i = 1 To NumAreas
RowOffset = SelAreas(i).Row - TopRow
ColOffset = SelAreas(i).Column - LeftCol
NonEmptyCellCount = NonEmptyCellCount + _
Application.CountA(Range(PasteRange.Offset(RowOffs et,
ColOffset), _
PasteRange.Offset(RowOffset + SelAreas(i).Rows.Count - 1,
_
ColOffset + SelAreas(i).Columns.Count - 1)))
Next i

' If paste range is not empty, warn user
If NonEmptyCellCount < 0 Then _
If MsgBox("Overwrite existing data?", vbQuestion + vbYesNo, _
"Copy Multiple Selection") < vbYes Then Exit Sub

' Copy and paste each area
For i = 1 To NumAreas
RowOffset = SelAreas(i).Row - TopRow
ColOffset = SelAreas(i).Column - LeftCol
SelAreas(i).Copy PasteRange.Offset(RowOffset, ColOffset)
Next i

End Sub

Cheers!

I just noticed that some of the lines broke in some weird places, if
you don't want to pick through the code let me know and I'd be happy
to email you the code.