Copy and Paste Multiple Ranges

[jroo]

I want to copy multiple range and paste them to another worksheet. Is there a way to do this without having to create more than one variable. Below i created the variable copy1 which copies ranges in column A and C. I want to paste this to columns A and C in another worksheet. But i get the following error: "this command cannot be used on multiple selections.

Is this there a better solution.. I want to avoid creating more than one variable.


Sub Macro1()


Set copy1 = Worksheets("Sheet1").Range("A1:A13,C1:C13")

copy1.Copy Destination:=Worksheets("Sheet2").Range("A1,C1")
End Sub

 

[parry]

Hi, unfortunately Excel will not let you copy multiple selections. However, you can loop through a range and put these values in destination cells. Heres an example where the user has already selected the multi-range before running the macro, then we ask the user where to start placing the values.

Sub PowerCopy()
Dim Rng As Range, Dest As Range, Element, a As Integer

'Rng is the cells to copy. Note that the User must have selected
'the multi-range before executing macro. Use CTRL key to select
'non-contiguous ranges
Set Rng = Selection

'Find first destination cell by asking user
Set Dest = Application.InputBox(prompt:="Select a cell", _
Title:="Paste Destination", Type:=8)

'set value of first row
a = 0

'for each cell to copy, place value in destination cell
'then go down one row down from here for each element
For Each Element In Rng
Dest.Offset(a, 0).Value = Element.Value
a = a + 1
Next Element

End Sub

 

[Legacy 12630]

Or perhaps this :-

Sub CopyMultipleSelection()
Dim sourceSh As Worksheet, destSh As Worksheet
Dim numAreas As Integer, a As Integer
Dim selAreas() As Range
Dim sourceRng As Range, destCell As Range
Dim topRow As Long, leftCol As Integer
Dim rowOffset As Long, colOffset As Integer

Set sourceSh = Sheets("Sheet1")
sourceSh.Activate
Set sourceRng = Selection
Set destSh = Sheets("Sheet2")

numAreas = sourceRng.Areas.Count
ReDim selAreas(a To numAreas)
For a = 1 To numAreas
Set selAreas(a) = sourceRng.Areas(a)
Next

topRow = sourceSh.Rows.Count
leftCol = sourceSh.Columns.Count
For a = 1 To numAreas
If selAreas(a).Row < topRow Then topRow = selAreas(a).Row
If selAreas(a).Column < leftCol Then leftCol = selAreas(a).Column
Next
Set destCell = destSh.Cells(topRow, leftCol)
For a = 1 To numAreas
rowOffset = selAreas(a).Row - topRow
colOffset = selAreas(a).Column - leftCol
selAreas(a).Copy destCell.Offset(rowOffset, colOffset)
Next
End Sub

 

[MrYorkie]

I'm still new to this but I've trying everything I can think of with no luck. Does anyone know what I need to do to this to make it paste values only?

 

[MrYorkie]

Sorry, I meant to ask how to modify this to paste values.
Still learning how to post.

Or perhaps this :-

Sub CopyMultipleSelection()
Dim sourceSh As Worksheet, destSh As Worksheet
Dim numAreas As Integer, a As Integer
Dim selAreas() As Range
Dim sourceRng As Range, destCell As Range
Dim topRow As Long, leftCol As Integer
Dim rowOffset As Long, colOffset As Integer

Set sourceSh = Sheets("Sheet1")
sourceSh.Activate
Set sourceRng = Selection
Set destSh = Sheets("Sheet2")

numAreas = sourceRng.Areas.Count
ReDim selAreas(a To numAreas)
For a = 1 To numAreas
Set selAreas(a) = sourceRng.Areas(a)
Next

topRow = sourceSh.Rows.Count
leftCol = sourceSh.Columns.Count
For a = 1 To numAreas
If selAreas(a).Row < topRow Then topRow = selAreas(a).Row
If selAreas(a).Column < leftCol Then leftCol = selAreas(a).Column
Next
Set destCell = destSh.Cells(topRow, leftCol)
For a = 1 To numAreas
rowOffset = selAreas(a).Row - topRow
colOffset = selAreas(a).Column - leftCol
selAreas(a).Copy destCell.Offset(rowOffset, colOffset)
Next
End Sub

 

[MrYorkie]

Never mind I figured it out. Thanks anyway.

 

[Young_Money]

hey im curious to know what you did in the end
please advise