Working With Multiple Source and Destination Ranges

[GEdwards]

I am using excel 2003.

I have numerous ranges on 1 worksheet that I want to copy over to a new
workbook and worksheet. Is it possible to have multiple source ranges and
multiple destination ranges coded within a few lines of code? I am referring
to the lines in the code below of ,

"Set sourceRange = ..." and "Set destRange = DestSH ..."

I have coded a working macro to do this in numerous iterations to complete
the destination worksheet, but the macro is very long and code is duplicated
many times. I would like a simpler way to do this. I am new to all this
stuff and attempted something different (please hold the laughter).

Here is the part of the code I have attempted to which I receive "Run-time
error '13', Type mismatch":


Set sourceRange = ThisWorkbook.Sheets("Estimate").Range("B3:B7") &
Range("B20:B20") & Range("I5:I5") & Range("K4:K4")

'Sheet name of the destination, Invoice worksheet
Set DestSH = DestWB.Worksheets("Invoice")

DestWB.Activate

Set destRange = DestSH.Range("B3:B7") & DestSH.Range("B20:B20") &
DestSH.Range("I5:I5") & DestSH.Range("K4:K4")

With sourceRange
Set destRange = destRange.Resize(.Rows.Count, .Columns.Count)
End With
destRange.Value = sourceRange.Value '<== Write the new values to the
destination sheet


Suggestions?

 

[Dave Peterson]

You can use something like this:
Set SourceRange = ThisWorkbook.Sheets("Estimate").Range("B3:B7,b20,i5,k4")

But that won't get you the results you want in your .value = .value statement.

This portion:

With sourceRange
Set destRange = destRange.Resize(.Rows.Count, .Columns.Count)
End With

Will use the first area in the sourcerange to determine the .rows.count and
..columns.count.

Since you're using the same address in both sheets, I'd use something like:

Option Explicit
Sub testme()

Dim myAddresses As Variant
Dim SourceWks As Worksheet
Dim DestWks As Worksheet
Dim DestWb as workbook
Dim aCtr As Long

myAddresses = Array("B3:b7", "b20", "i5", "K4")

set destwb = workbooks("someworkbooknamehere.xls")

Set SourceWks = ThisWorkbook.Sheets("Estimate")
Set DestWks = DestWB.Worksheets("Invoice"))

For aCtr = LBound(myAddresses) To UBound(myAddresses)
DestWks.Range(myAddresses(aCtr)).Value _
= SourceWks.Range(myAddresses(aCtr))
Next aCtr

End Sub

(Untested, uncompiled. I actually tested against two worksheets in
ThisWorkbook, but then I added some of your existing code -- I don't think I
screwed that up, but...)

 

[GEdwards]

Thanks for the code Dave. I have worked it into my macro but the range from
B3:B7 does not copy over; the 3 other ranges DO copy over however.

myAddresses = Array("B3:B7", "K4", "I5", "B20")

Set SourceWks = ThisWorkbook.Sheets("Estimate")
Set DestWks = DestWb.Worksheets("Invoice")

For aCtr = LBound(myAddresses) To UBound(myAddresses)
DestWks.Range(myAddresses(aCtr)).Value _
= SourceWks.Range(myAddresses(aCtr))
Next aCtr

 

[Dave Peterson]

Try adding .value to that SourceWks.range portion:

For aCtr = LBound(myAddresses) To UBound(myAddresses)
DestWks.Range(myAddresses(aCtr)).Value _
= SourceWks.Range(myAddresses(aCtr)).Value
Next aCtr

 

[GEdwards]

FANTASTIC!!!

Many thanks Dave, works great!

Try adding .value to that SourceWks.range portion:

For aCtr = LBound(myAddresses) To UBound(myAddresses)
DestWks.Range(myAddresses(aCtr)).Value _
= SourceWks.Range(myAddresses(aCtr)).Value
Next aCtr