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

[Whereabout]

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.

 

[JW00]

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.

 

[Whereabout]

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.

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.

 

[JW00]

Hi, my apologies for any misunderstanding, I think the following adaptation of the code may work for you.

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

 

[JW00]

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.

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

 

[Whereabout]

Hi, my apologies for any misunderstanding, I think the following adaptation of the code may work for you.

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

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.

 

[JW00]

Thanks, good luck with your project.

 

[Whereabout]

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.

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

Wont you in this piece of code lack the i=i+1 in the end for it to continue through my worksheet?

 

[JW00]

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.

 

[Whereabout]

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.

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

 

[JW00]

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.