Attempting to copy multiple ranges from one worksheet to another

[blobb]

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

 

[Norman Jones]

Hi Blobb,

Your code attempts to increase the size
of various ranges so that the new range
will have the same number of rows and
columns as an entire worksheet,

Clearly, for any range except for a range
which is anchored in A1, this will not be
possible and, hence, the code complains.

T see this more clearly, try the following
simplified code:



'=============>>
Public Sub Demo()
Dim Rng As Range
Dim Rng2 As Range
With ActiveSheet
Set Rng = .Range("A110"). _
Resize(.Rows.Count, .Columns.Count)
MsgBox Rng.Address

Set Rng2 = .Range("A210"). _
Resize(.Rows.Count, .Columns.Count)
MsgBox Rng2.Address
End With
End Sub
'<<=============

The code accepts the first range but objects
to the second, invalid range.

 

[Rick Rothstein \(MVP - VB\)]

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]

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\)]

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]

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\)]

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]

OH this is great! Thank you so much for your help!

blobb