VBA to copy and past based on a dynamic range

[Rpaikh]

Hello All Experts,


I have a standard template column A-D and variable value column G-H.

I would like to copy and past a variable value into a standard template then repeat it until the last row of variable value.

After some searching within the board, I could came up with below codes but still has no idea how to add variable value into the copy loop.


Codes;

Sub Copy()

Dim i As Long

For i = 1 To Worksheets("Sheet1").Range("J1").Value
Range("A2:D7").Select
Selection.Copy
Range("A2").Offset(6 * i, 0).Select
Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Next i

End Sub

I've attached a snapshot below in case my English might confuse you.

 

[Fluff]

How about

Sub Rpaikh()
   Dim Cl As Range
   Range("A2:D7").Copy Range("A8").Resize(6 * Range("J1").Value, 4)
   For Each Cl In Range("G2", Range("G" & Rows.Count).End(xlUp))
      Cl.Resize(, 2).Copy Range("A" & Rows.Count).End(xlUp).Offset(1).Resize(1 * 6, 2)
   Next Cl
End Sub

 

[lrobbo314]

Another option.

Sub Combine()
Dim Cust() As Variant: Cust = Range("C2:D" & Range("C" & Rows.Count).End(xlUp).Row).Value
Dim Prod() As Variant: Prod = Range("G2:H" & Range("G" & Rows.Count).End(xlUp).Row).Value
Dim Res() As Variant: ReDim Res(1 To UBound(Cust) * UBound(Prod), 1 To 4)
Dim cnt As Long: cnt = 1


For i = 1 To UBound(Prod)
    For j = 1 To UBound(Cust)
        Res(cnt, 1) = Prod(i, 1)
        Res(cnt, 2) = Prod(i, 2)
        Res(cnt, 3) = Cust(j, 1)
        Res(cnt, 4) = Cust(j, 2)
        cnt = cnt + 1
    Next j
Next i


Range("L1:O1").Value = Array("Products", "Description", "Customer", "KeyFigures")
Range("L2").Resize(UBound(Res), 4).Value = Res
End Sub

 

[Rpaikh]

Thanks a lot !!! Fluff and lrobbo314.


Both codes are work perfectly. I will study on your codes structures for my further improvement.

 

[Rpaikh]

Hello lrobbo314,


Just one quick question if I would like to extend standard template from A:D to A:F and variable value from G:H to G:I , how would the code looks like ?

Another option.

Sub Combine()
Dim Cust() As Variant: Cust = Range("C2:D" & Range("C" & Rows.Count).End(xlUp).Row).Value
Dim Prod() As Variant: Prod = Range("G2:H" & Range("G" & Rows.Count).End(xlUp).Row).Value
Dim Res() As Variant: ReDim Res(1 To UBound(Cust) * UBound(Prod), 1 To 4)
Dim cnt As Long: cnt = 1


For i = 1 To UBound(Prod)
    For j = 1 To UBound(Cust)
        Res(cnt, 1) = Prod(i, 1)
        Res(cnt, 2) = Prod(i, 2)
        Res(cnt, 3) = Cust(j, 1)
        Res(cnt, 4) = Cust(j, 2)
        cnt = cnt + 1
    Next j
Next i


Range("L1:O1").Value = Array("Products", "Description", "Customer", "KeyFigures")
Range("L2").Resize(UBound(Res), 4).Value = Res
End Sub

 

[Fluff]

Thanks a lot !!! Fluff and lrobbo314.


Both codes are work perfectly. I will study on your codes structures for my further improvement.

You're welcome & thanks for the feedback

 

[lrobbo314]

Hello lrobbo314,


Just one quick question if I would like to extend standard template from A:D to A:F and variable value from G:H to G:I , how would the code looks like ?

Can you post another example of what your data and results look like?

 

[Rpaikh]

Can you post another example of what your data and results look like?

Hello Irobbo314,



From your codes mentioned above, if I would like to extend standard template from A:D to A:E and variable value from G:H to G:I , how would the code looks like ?

[/URL][/IMG]

 

[lrobbo314]

How about this?

Sub Combine()
Dim Cust() As Variant: Cust = Range("D2:E" & Range("D" & Rows.Count).End(xlUp).Row).Value
Dim Prod() As Variant: Prod = Range("G2:I" & Range("G" & Rows.Count).End(xlUp).Row).Value
Dim Res() As Variant: ReDim Res(1 To UBound(Cust) * UBound(Prod), 1 To 5)
Dim cnt As Long: cnt = 1

For i = 1 To UBound(Prod)
    For j = 1 To UBound(Cust)
        Res(cnt, 1) = Prod(i, 1)
        Res(cnt, 2) = Prod(i, 2)
        Res(cnt, 3) = Prod(i, 3)
        Res(cnt, 4) = Cust(j, 1)
        Res(cnt, 5) = Cust(j, 2)
        cnt = cnt + 1
    Next j
Next i

Range("L1:O1").Value = Array("Products", "Description", "Customer", "KeyFigures")
Range("L2").Resize(UBound(Res), 5).Value = Res
End Sub

 

[Rpaikh]

Thanks you very much once again ! It works as I expected !

How about this?

Sub Combine()
Dim Cust() As Variant: Cust = Range("D2:E" & Range("D" & Rows.Count).End(xlUp).Row).Value
Dim Prod() As Variant: Prod = Range("G2:I" & Range("G" & Rows.Count).End(xlUp).Row).Value
Dim Res() As Variant: ReDim Res(1 To UBound(Cust) * UBound(Prod), 1 To 5)
Dim cnt As Long: cnt = 1

For i = 1 To UBound(Prod)
    For j = 1 To UBound(Cust)
        Res(cnt, 1) = Prod(i, 1)
        Res(cnt, 2) = Prod(i, 2)
        Res(cnt, 3) = Prod(i, 3)
        Res(cnt, 4) = Cust(j, 1)
        Res(cnt, 5) = Cust(j, 2)
        cnt = cnt + 1
    Next j
Next i

Range("L1:O1").Value = Array("Products", "Description", "Customer", "KeyFigures")
Range("L2").Resize(UBound(Res), 5).Value = Res
End Sub