ExcelBanter

ExcelBanter (https://www.excelbanter.com/)
-   Excel Programming (https://www.excelbanter.com/excel-programming/)
-   -   VBA Copy & Paste multiple ranges (https://www.excelbanter.com/excel-programming/448668-vba-copy-paste-multiple-ranges.html)

garygoodguy

VBA Copy & Paste multiple ranges
 
Hi, I have the following code to take figures from a hidden worksheet and to place them into specific cells in a visible worksheet in the same 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 have about 100+ rows that will need to be pulled across to the destination sheet. My question is is there a better way to do this than my approach above? The "GetValues" are all in one continuous block but the 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[_2_]

VBA Copy & Paste multiple ranges
 
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[_2_]

VBA Copy & Paste multiple ranges
 
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




All times are GMT +1. The time now is 05:17 PM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com