VBA Copy & Paste multiple ranges

[garygoodguy]

Hi, I have the following code to take figures from a hidden workshee
and to place them into specific cells in a visible worksheet in the sam
workbook.

Dim ShGet As Worksheet
Dim ShDest As Worksheet
Dim ShStart As Worksheet
Set ShGet = Sheets("GetValues")
Set ShDest = Sheets("PasteValues")
Set ShStart = Sheets("Start")

If ShStart.Range("A1").Value = "one" Then
ShDest.Range("F9:AC9").Value = ShGet.Range("C204:Z204").Value
ShDest.Range("F15:AC15").Value = ShGet.Range("C207:Z207").Value
ElseIf ShStart.Range("P40").Value = "two" Then
ShDest.Range("F9:AC9").Value = ShGet.Range("C204:Z204").Value
ShDest.Range("F15:AC15").Value = ShGet.Range("C207:Z207").Value
ElseIf ShStart.Range("P40").Value = "three" Then
ShDest.Range("F9:AC9").Value = ShGet.Range("C204:Z204").Value
ShDest.Range("F15:AC15").Value = ShGet.Range("C207:Z207").Value
ElseIf ShStart.Range("P40").Value = "four" Then
ShDest.Range("F9:AC9").Value = ShGet.Range("C204:Z204").Value
ShDest.Range("F15:AC15").Value = ShGet.Range("C207:Z207").Value
End If

NB: I've only placed two ranges in each if/elseif, but actually I hav
about 100+ rows that will need to be pulled across to the destinatio
sheet. My question is is there a better way to do this than my approac
above? The "GetValues" are all in one continuous block but th
destination cells will be placed on specific rows and not (i.e. rows 11
13, 24, 26, 46, 48, etc). The ranges will not change.

Thanks in advance

 

[GS]

Well.., I don't see why you need to use an If construct when the same
two ranges get copied over in all cases. Otherwise, yes there is a much
more efficient way to handle this but it would help if you provide
better info. For example, rows 9 and 15 aren't in your list of sample
target rows, but you show them for each If evaluation!

Show some of the actual ranges for...

ShStart.[A1]:"one": target=source
ShStart.[P40}:"two": target=source
ShStart.[P40}:"three": target=source
ShStart.[P40}:"four": target=source

...where target is the range address on ShDest, and source is the range
address on ShGet, so we have real case scenario to work with.

--
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion

 

[GS]

Here's one example that uses the info as you provided...

Sub TransferData()
Const sXfers1$ = "A1=one,F9:AC9=C204:Z204,F15:AC15=C207:Z207"
Const sXfers2$ = "P40=two,F9:AC9=C204:Z204,F15:AC15=C207:Z207"
Const sXfers3$ = "P40=three,F9:AC9=C204:Z204,F15:AC15=C207:Z207"
Const sXfers4$ = "P40=four,F9:AC9=C204:Z204,F15:AC15=C207:Z207"

Dim vDataXfers$(1 To 4), vRef, v, n&, k&
Dim wksSource As Worksheet, wksTarget As Worksheet

vDataXfers(1) = sXfers1: vDataXfers(2) = sXfers2
vDataXfers(3) = sXfers3: vDataXfers(4) = sXfers4
Set wksSource = Sheets("GetValues"): Set wksTarget =
Sheets("PasteValues")

For n = LBound(vDataXfers) To UBound(vDataXfers)
v = Split(vDataXfers(n), ","): vRef = Split(v(0), "=")
If Sheets("Start").Range(vRef(0)) = vRef(1) Then
For k = 1 To UBound(v)
vRef = Split(v(k), "=")
wksTarget.Range(vRef(0)).Value = wksSource.Range(vRef(1)).Value
Next 'k
End If
Next 'n
End Sub

...where sXfers# is a delimited string 'list' of delimited value pairs,
starting with the criteria for the If evaluation. (Since the range
addresses use the colon character I changed my original list delimiter
from a colon to a comma) Edit the 4 sXfers# strings to match your
needs.

--
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion