View Single Post
  #7   Report Post  
Posted to microsoft.public.excel.programming
Rick Rothstein \(MVP - VB\)[_2020_] Rick Rothstein \(MVP - VB\)[_2020_] is offline
external usenet poster
 
Posts: 1
Default Attempting to copy multiple ranges from one worksheet to anoth

I think I've got it now. Give this code a try and see if it does what you
want...

Sub CopyToSummaryData()
Dim R As Range
Dim Cnt As Long
Dim LastRow As Long
Const DataColumn As String = "D"
On Error GoTo Whoops
Application.ScreenUpdating = False
Application.EnableEvents = False
With Worksheets("SummaryData")
LastRow = .Cells(Rows.Count, DataColumn).End(xlUp).Row
If Not (LastRow = 1 And .Cells(1, DataColumn).Value = "") Then
LastRow = LastRow + 1
End If
For Each R In Range("A4,D6:AC6,D10:J10,L10:R10,D11:J11,L11:R11")
' The "D" in the next statement is because your post
' specified the A4 value should be copied to Column D
R.Copy .Cells(LastRow, "D").Offset(0, Cnt)
Cnt = Cnt + R.Count
Next
End With
Whoops:
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub

Note that the calculation for the LastRow is dependent on Row D never having
a blank entries in it. If it is possible that there could be empty cells in
Column D, then change the "D" assignment in the Const statement to the
letter designation of a column where there can be no empty cells.

Rick


"blobb" wrote in message
...
Okay let me see if I can clarify...
(1) by last row or first blank row, i mean the first row that is blank
below
previously entered data. So, I could have data upto row 5 or upto row 9,
I
would want to paste my copied data into row 6 or row 10. There should not
be
any blank rows (gaps) in "SummaryData" up to the end of the file.

(2) yes, that was just an example off the top of my head. SubjID A4 would
become SummaryData D10, SubjID D6:AC6 would become SummaryData D11:the
span
of that range. I do want to put each copied cell next to the previous one
on
the same line or row.

sorry for the confusion.

blobb

"Rick Rothstein (MVP - VB)" wrote:

I'm afraid your posting has added some confusion. See below...

copy a range of cells ("A4, D6:AC6, D10:J10, L10:R10, D11:J11, ") in
Worksheet "SubjID" to the lastrow (or first blank row) of
"SummaryData"


If there are gaps (empty rows) before the last row of data, then the last
row will be different form the first blank row... which did you want?

So A4 would become D6 or D10, D6:AC6 would become
D6:AF6 or D10:AF10.


Assuming you mean the 6 or 10 to be the last row (or first blank row
depending on your answer to the above), and if you copy A4 into, say,
D10,
then moving D6:AC6 into a range starting at D10 would overwrite the A4
value
just copied into there. Also, the span of D6:AC6 is not the same as the
span
of D10:AF10. I'm assuming these were just top of the head examples. Can I
assume you want to put A4 into D10, and then lay the other ranges next to
each other (no column gaps between them) across that same row?

Rick


"blobb" wrote in message
...
Oh okay. So it sounds like I mis-interpreted what the code was
attempting
to
do. Basically what I want to do is copy a range of cells ("A4, D6:AC6,
D10:J10, L10:R10, D11:J11, ") in Worksheet "SubjID" to the lastrow (or
first
blank row) of "SummaryData". Um, so on the worksheet "SubjID" the
cells
that
I want to copy are not on the same row and I want all the cells to be
on
the
same row in the "SummaryData" worksheet. So A4 would become D6 or D10,
D6:AC6 would become D6:AF6 or D10:AF10. Is there a good way to do this
with
a VBA macro?

Thank you so much!

Blobb

"Rick Rothstein (MVP - VB)" wrote:

I see two problems at a quick glance. The first is the cause of your
error
message and is probably a simple mis-type... the argument to your
'lastrow'
function is of type Workbook, but you are passing it a worksheet. I'm
guessing you wanted the argument to be declared as Workbook. The
second
problem is in your Resize method call. You are specifying the number
of
rows
and number of columns in the entire worksheet as its arguments (you
don't
need the dot in front of each of those arguments by the way) which
would
mean you are trying to resize past the limits of the worksheet.

I'm not 100% sure what you are doing here. Is your 'lastrow' function
attempting to get the last filled in row on the Summary Data Sheet?
Are
you
attempting to copy each of the ranges A4, D6:AC6, D10:J10, L10:R10,
D11:J11,
and L11:R11 to that last row somehow (if so, where)?

Rick


"blobb" wrote in message
...
Hi. I am new to VBA and am attempting to copy multiple ranges found
in
worksheet "SubjID" to a Summary Data Sheet. I found the following
code
online (I included the form frmSubjIDPrompt - simply goes to the
SubjID
worksheet that the user inputs). I keep getting the error "Type
Mismatch"
at
the set destrange command. I am unable to figure out why that would
be
happening. Could someone help? Thank you!

Sub CopyMultiAreaValues()

Dim SubjID As Integer
Dim destrange As Range
Dim smallrng As Range

'prompt for subject id number and go to that worksheet

frmSubjIDPrompt.Show

'select range of multiple areas to copy to SummaryData worksheet

For Each smallrng In ActiveSheet. _
Range("a4,d6:AC6,D10:J10,L10:R10,D11:J11,L11:R11") .Areas
With smallrng
Set destrange = Sheets("SummaryData").Range("D" & _
lastrow(Sheets("SummaryData")) + 1).Resize( _
.Rows.Count, .Columns.Count)
End With
destrange.Value = smallrng.Value
Next smallrng
End Sub

Function lastrow(sh As Workbook)
On Error Resume Next
lastrow = sh.Cells.Find(What:="*", _
After:=sh.Range("D1"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
On Error GoTo 0
End Function