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!