Two Questions multiple ranges and to add to a spreadsheet

Posted by Christopher on April 25, 2001 8:10 AM

I am compiling a survey. The Survey is of course in an Excel spreedsheet I would like to have it copy the raw data to a seperate sheet where it will have all the surveys data.

Now how do I select and copy mulitple ranges (ie A1,E3:E9,J6:L9)

Then on top of that I want it to go into the first empty row on the compiled survey data sheet....

Any help would be much appreciated....

Posted by Dave Hawley on April 25, 2001 10:00 PM

Hi Christopher

You will need a Custom macro to do this. Try this one:

Sub CustomCopy()
'Witten by OzGrid Business Applications
'www.ozgrid.com

''''''''''''''''''''''''''''''''''''''''''
'Allows the copy a of non contiguous range
''''''''''''''''''''''''''''''''''''''''''

Dim RcopyRange As Range
Dim RdestRange As Range
Dim i As Integer
'In the case of an invalid range
On Error Resume Next

'Show Input box so they can select copy range.
Set RcopyRange = Application.InputBox( _
Prompt:="Holding your Ctrl key, select your non contiguous range", _
Title:="OzGrid Business Applications", Type:=8)

'In valid range, or they canceled
If RcopyRange Is Nothing Then 'In valid range
Exit Sub
End If

'All OK so carry on.
DestinationRange:
'Show Input box so they can select destination range.
Set RdestRange = Application.InputBox( _
Prompt:="Select a single destination cell", _
Title:="OzGrid Business Applications", Type:=8)

'In valid range, or they canceled
If RdestRange Is Nothing Then
Exit Sub
End If

'Loop through and copy each block
'Paste to right of range variant "RcopyRange"
For i = 1 To RcopyRange.Areas.Count
RcopyRange.Areas(i).Copy
If i = 1 Then
RdestRange.PasteSpecial xlPasteValues
Else
RdestRange.End(xlToRight).End _
(xlToLeft).Offset(0, 1).PasteSpecial xlPasteValues
End If

Next i
Application.CutCopyMode = False
'Release memory
Set RcopyRange = Nothing
Set RdestRange = Nothing

End Sub

To put in place, push Alt+F11 and go to Insert>Module and paste in the code above.
Push Alt+Q and then push Alt+F8, click Options and assign a shortcut key.

Now Save

To find your first blank Row select cell A1 and push Ctrl+ Down Arrow. This will be your "Single" cell selection. But do this BEFORE running the Macro.

Dave
OzGrid Business Applications