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

W

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.
 
Sort by date Sort by votes
Sorry I am struggling to understand, in the original example between 1 & 2 in the sheet "PFD Copy" the offsets were either 1 (G6 then G7) or 16 (H41:H44 then H57:H60) depending on the cells copied & 30 in the "Buffers target", maybe post your "PFD Copy" sheet & your desired output in the "Buffers target" sheet.
 
Upvote 0

Excel Facts

Remove leading & trailing spaces
Save as CSV to remove all leading and trailing spaces. It is faster than using TRIM().
JW00 said:
Sorry I am struggling to understand, in the original example between 1 & 2 in the sheet "PFD Copy" the offsets were either 1 (G6 then G7) or 16 (H41:H44 then H57:H60) depending on the cells copied & 30 in the "Buffers target", maybe post your "PFD Copy" sheet & your desired output in the "Buffers target" sheet.
Click to expand...
Hi JW00

Just a quick answer, from what you have written it seems like you understand perfectly. The ranges offset various from either 1, 16 and 30, and I have tried to make my excel sheets so uniform down through the whole workbook.

I have tried to attach images of my sheets. The first amount of code I did myself worked copying the right things from "PFD Copy" to "Buffers target". But if it is possible to multiply the offsets that would also be smart.
The suggestion on code I received from Offthelip moves the copied ranges horizontaly to the right, instead of downwards. This can be seen on the second image (Buffer target) where the data underneath "Buffer 1" (written with yellow background) is how I want it to look.

Hope this clarifies a bit.
 

Attachments

  • PFD Copy.png
    PFD Copy.png
    135.5 KB · Views: 8
  • buffer target..png
    buffer target..png
    30.2 KB · Views: 8
Upvote 0
Hi, my apologies for any misunderstanding, I think the following adaptation of the code may work for you.

VBA Code: 
Sub Frommastertobuftarget()
Dim cell As Range
Dim i As Long
i = 1
    For Each cell In Sheets("PFD Copy").Range("A6:A34")
        If i = 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"))
        Else
            i = cell.Offset(-1, 0)
            Sheets("PFD Copy").Range("G6").Offset(i * 1, 0).Copy (Sheets("Buffers target").Range("B4").Offset(i * 30, 0))
            Sheets("PFD Copy").Range("D6").Offset(i * 1, 0).Copy (Sheets("Buffers target").Range("B5").Offset(i * 30, 0))
            Sheets("PFD Copy").Range("G41:G44").Offset(i * 16, 0).Copy (Sheets("Buffers target").Range("A15:A18").Offset(i * 30, 0))
            Sheets("PFD Copy").Range("F41:F44").Offset(i * 16, 0).Copy (Sheets("Buffers target").Range("B15:B18").Offset(i * 30, 0))
            Sheets("PFD Copy").Range("H41:H44").Offset(i * 16, 0).Copy (Sheets("Buffers target").Range("E15:E18").Offset(i * 30, 0))
            Sheets("PFD Copy").Range("H45").Offset(i * 16, 0).Copy (Sheets("Buffers target").Range("E14").Offset(i * 30, 0))
            Sheets("PFD Copy").Range("I48").Offset(i * 16, 0).Copy (Sheets("Buffers target").Range("E23").Offset(i * 30, 0))
            Sheets("PFD Copy").Range("N6").Offset(i * 1, 0).Copy (Sheets("Buffers target").Range("F9").Offset(i * 30, 0))
            Sheets("PFD Copy").Range("I49:I51").Offset(i * 16, 0).Copy (Sheets("Buffers target").Range("C23:C25").Offset(i * 30, 0))
        End If
        i = i + 1
    Next cell
    
End Sub
 
Upvote 0
Just washing up & realised the code could be half the size like 'offthelip' originally had, I am using this is a learning process for myself whilst trying to help others.

VBA Code: 
Sub Frommastertobuftarget()
Dim cell As Range
Dim i As Long

    For Each cell In Sheets("PFD Copy").Range("A6:A34")
            i = cell.Value - 1
            Sheets("PFD Copy").Range("G6").Offset(i * 1, 0).Copy (Sheets("Buffers target").Range("B4").Offset(i * 30, 0))
            Sheets("PFD Copy").Range("D6").Offset(i * 1, 0).Copy (Sheets("Buffers target").Range("B5").Offset(i * 30, 0))
            Sheets("PFD Copy").Range("G41:G44").Offset(i * 16, 0).Copy (Sheets("Buffers target").Range("A15:A18").Offset(i * 30, 0))
            Sheets("PFD Copy").Range("F41:F44").Offset(i * 16, 0).Copy (Sheets("Buffers target").Range("B15:B18").Offset(i * 30, 0))
            Sheets("PFD Copy").Range("H41:H44").Offset(i * 16, 0).Copy (Sheets("Buffers target").Range("E15:E18").Offset(i * 30, 0))
            Sheets("PFD Copy").Range("H45").Offset(i * 16, 0).Copy (Sheets("Buffers target").Range("E14").Offset(i * 30, 0))
            Sheets("PFD Copy").Range("I48").Offset(i * 16, 0).Copy (Sheets("Buffers target").Range("E23").Offset(i * 30, 0))
            Sheets("PFD Copy").Range("N6").Offset(i * 1, 0).Copy (Sheets("Buffers target").Range("F9").Offset(i * 30, 0))
            Sheets("PFD Copy").Range("I49:I51").Offset(i * 16, 0).Copy (Sheets("Buffers target").Range("C23:C25").Offset(i * 30, 0))
    Next cell
    
End Sub
 
Upvote 0
JW00 said:
Hi, my apologies for any misunderstanding, I think the following adaptation of the code may work for you.

VBA Code: 
Sub Frommastertobuftarget()
Dim cell As Range
Dim i As Long
i = 1
    For Each cell In Sheets("PFD Copy").Range("A6:A34")
        If i = 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"))
        Else
            i = cell.Offset(-1, 0)
            Sheets("PFD Copy").Range("G6").Offset(i * 1, 0).Copy (Sheets("Buffers target").Range("B4").Offset(i * 30, 0))
            Sheets("PFD Copy").Range("D6").Offset(i * 1, 0).Copy (Sheets("Buffers target").Range("B5").Offset(i * 30, 0))
            Sheets("PFD Copy").Range("G41:G44").Offset(i * 16, 0).Copy (Sheets("Buffers target").Range("A15:A18").Offset(i * 30, 0))
            Sheets("PFD Copy").Range("F41:F44").Offset(i * 16, 0).Copy (Sheets("Buffers target").Range("B15:B18").Offset(i * 30, 0))
            Sheets("PFD Copy").Range("H41:H44").Offset(i * 16, 0).Copy (Sheets("Buffers target").Range("E15:E18").Offset(i * 30, 0))
            Sheets("PFD Copy").Range("H45").Offset(i * 16, 0).Copy (Sheets("Buffers target").Range("E14").Offset(i * 30, 0))
            Sheets("PFD Copy").Range("I48").Offset(i * 16, 0).Copy (Sheets("Buffers target").Range("E23").Offset(i * 30, 0))
            Sheets("PFD Copy").Range("N6").Offset(i * 1, 0).Copy (Sheets("Buffers target").Range("F9").Offset(i * 30, 0))
            Sheets("PFD Copy").Range("I49:I51").Offset(i * 16, 0).Copy (Sheets("Buffers target").Range("C23:C25").Offset(i * 30, 0))
        End If
        i = i + 1
    Next cell
   
End Sub
Click to expand...
IT WORKS PERFECTLY :)

So nice. really happy. Now I just need to sit down and try to understand all the code so I can use it other places to.

Thanks once again.
 
Upvote 0
JW00 said:
Just washing up & realised the code could be half the size like 'offthelip' originally had, I am using this is a learning process for myself whilst trying to help others.

VBA Code: 
Sub Frommastertobuftarget()
Dim cell As Range
Dim i As Long

    For Each cell In Sheets("PFD Copy").Range("A6:A34")
            i = cell.Value - 1
            Sheets("PFD Copy").Range("G6").Offset(i * 1, 0).Copy (Sheets("Buffers target").Range("B4").Offset(i * 30, 0))
            Sheets("PFD Copy").Range("D6").Offset(i * 1, 0).Copy (Sheets("Buffers target").Range("B5").Offset(i * 30, 0))
            Sheets("PFD Copy").Range("G41:G44").Offset(i * 16, 0).Copy (Sheets("Buffers target").Range("A15:A18").Offset(i * 30, 0))
            Sheets("PFD Copy").Range("F41:F44").Offset(i * 16, 0).Copy (Sheets("Buffers target").Range("B15:B18").Offset(i * 30, 0))
            Sheets("PFD Copy").Range("H41:H44").Offset(i * 16, 0).Copy (Sheets("Buffers target").Range("E15:E18").Offset(i * 30, 0))
            Sheets("PFD Copy").Range("H45").Offset(i * 16, 0).Copy (Sheets("Buffers target").Range("E14").Offset(i * 30, 0))
            Sheets("PFD Copy").Range("I48").Offset(i * 16, 0).Copy (Sheets("Buffers target").Range("E23").Offset(i * 30, 0))
            Sheets("PFD Copy").Range("N6").Offset(i * 1, 0).Copy (Sheets("Buffers target").Range("F9").Offset(i * 30, 0))
            Sheets("PFD Copy").Range("I49:I51").Offset(i * 16, 0).Copy (Sheets("Buffers target").Range("C23:C25").Offset(i * 30, 0))
    Next cell
   
End Sub
Click to expand...
Wont you in this piece of code lack the i=i+1 in the end for it to continue through my worksheet?
 
Upvote 0
No, your range it set to 29 cells (A6-A34), so it will l run through that range, I was using the "i" at the bottom to avoid the code returning to the first 'if' section.
 
Upvote 0
JW00 said:
No, your range it set to 29 cells (A6-A34), so it will l run through that range, I was using the "i" at the bottom to avoid the code returning to the first 'if' section.
Click to expand...
Arh I see.. didnt stumble over your change of "For Each cell In Sheets("PFD Copy").Range("A6:A34")". That is smart.

In this part "i = cell.Value - 1" will the number "1" change correspondingly to the number written in the cell in the ".Range("A6:A34")??

Sorry your solved my problem but just trying to understand and learn :)
 
Upvote 0
No problem, what happens is the "For" part moves one cell down on each loop, so for instance when we reach "A7" the cell value is 2, but we have only run 1 iteration to that point so if "i" equalled the cell value it would offset 2 times 30 but we only need to offset 30 at this point, so the "1" is just taken off the cell value every time, I hope that helps.
 
Upvote 0
You must log in or register to reply here.

Similar threads

C
  • Solved
Copy data from multiple sheets into a master sheet - VBA button stuck
Replies
3
Views
372
NdNoviceHlp
NdNoviceHlp
M
  • Solved
cut/copy and paste row based on cell value not being equal to specific text
Replies
6
Views
624
mlan1604
M
V
  • Question Question
Copy Range from Multiple Sheets and Paste Link into a Single Sheet
Replies
2
Views
339
vbascientist
V
D
  • Locked
  • Question Question
VBA to copy only matching data from 2 csv workbooks into the "Master Workbook"
Replies
1
Views
338
RoryA
RoryA
D
  • Solved
VBA to copy only matching data from 2 csv workbooks into the "MasterCSV"
2
Replies
18
Views
949
Peter_SSs
Peter_SSs

Forum statistics

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

Share this page

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