Copying of multiple ranges but with offset both on master sheet and destination

Whereabout

New Member
Joined
Jan 27, 2022
Messages
10
Office Version
  1. 365
Platform
  1. Windows
Hi All,

Hope there is someone who can help and utter newbie in VBA coding.

I have a workbook with multiple sheets. The first sheet (PFD Copy) is my master sheet from which I want data to be pasted into other sheets. The following is the code I have written so far:

Sub Frommastertobuftarget()

For Each Cell In Sheets("PFD Copy").Range("A6:A34")
If Cell.Value = "1" Then
Sheets("PFD Copy").Range("G6").Copy (Sheets("Buffers target").Range("B4"))
Sheets("PFD Copy").Range("D6").Copy (Sheets("Buffers target").Range("B5"))
Sheets("PFD Copy").Range("G41:G44").Copy (Sheets("Buffers target").Range("A15:A18"))
Sheets("PFD Copy").Range("F41:F44").Copy (Sheets("Buffers target").Range("B15:B18"))
Sheets("PFD Copy").Range("H41:H44").Copy (Sheets("Buffers target").Range("E15:E18"))
Sheets("PFD Copy").Range("H45").Copy (Sheets("Buffers target").Range("E14"))
Sheets("PFD Copy").Range("I48").Copy (Sheets("Buffers target").Range("E23"))
Sheets("PFD Copy").Range("N6").Copy (Sheets("Buffers target").Range("F9"))
Sheets("PFD Copy").Range("I49:I51").Copy (Sheets("Buffers target").Range("C23:C25"))
End If
Next Cell
End sub

This example is doing what I want it to, but the trick is that I have 29 almost identical commands with the only difference being that data taken from "PFD Copy" and the destination changes so the next command looks like:

For Each Cell In Sheets("PFD Copy").Range("A6:A34")
If Cell.Value = "2" Then
Sheets("PFD Copy").Range("G7").Copy (Sheets("Buffers target").Range("B34"))
Sheets("PFD Copy").Range("D7").Copy (Sheets("Buffers target").Range("B35"))
Sheets("PFD Copy").Range("G57:G60").Copy (Sheets("Buffers target").Range("A45:A48"))
Sheets("PFD Copy").Range("F57:F60").Copy (Sheets("Buffers target").Range("B45:B48"))
Sheets("PFD Copy").Range("H57:H60").Copy (Sheets("Buffers target").Range("E45:E48"))
Sheets("PFD Copy").Range("H61").Copy (Sheets("Buffers target").Range("E44"))
Sheets("PFD Copy").Range("I64").Copy (Sheets("Buffers target").Range("E53"))
Sheets("PFD Copy").Range("N7").Copy (Sheets("Buffers target").Range("F39"))
Sheets("PFD Copy").Range("I65:I67").Copy (Sheets("Buffers target").Range("C53:C55"))
End If
Next Cell

So to my actual question. Can you make an offset based on my "IF" command? So when the value of my "IF" changes from 1 to 2, the ranges from the first command offsets with different values?

And is there a smarter way of writing the code so I don't have to write the same code 29 times :)

Hope you can help me and my question is understandable.

Thanks in advance.
 
Sorry for posting again, I don't know how your system works but an extra line of code may help in certain instances & will do no harm if it is not needed. Maybe in the future you may only want to update "Buffer's" 1, 2, 6 & 20, the additional line of code would allow you to update just specific "Buffer's" providing you only list those "Buffer's" in column "A". After the "For" line insert "If IsEmpty(cell.Value) Then Exit For", all it does, is exits the code as soon as it reaches a blank cell, with current code if "A6:A15" equalled 1 to 10 when it reached "A16" the code would error out unless you had changed the range in vba, if you are always going to have 1 to 29 none of this matters. All the best with your project.
 
Upvote 0

Excel Facts

Formula for Yesterday
Name Manager, New Name. Yesterday =TODAY()-1. OK. Then, use =YESTERDAY in any cell. Tomorrow could be =TODAY()+1.

Forum statistics

Threads
1,224,822
Messages
6,181,165
Members
453,021
Latest member
Justyna P

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top