Create sets of data (repetitive copy-paste)

[edarevalo]

sample.xlsm

Hello,

Macro novice here, have work mostly on basic copy-paste codes but not the complex ones.

Been working on a working file with several parameters and would need to create several sets on the results sheet.

For example, I want to see on the result sheet, for each location:
1) Each "structure" code has to be assigned with each "Biz" code (so let's say one structure ID has a counterpart of 5 "Biz" codes.

Please see example result in the file's "results" sheet.

This has to be done for all locations so I was wondering how a code can be applied to this.

Thanks in advance!

[zbor]

Here, try this:

Sub combinate_data()
Dim ws1 As Worksheet, ws2 As Worksheet
Dim i As Long, k As Long

Set ws1 = Sheets("parameters")
Set ws2 = Sheets("results")

k = WorksheetFunction.CountA(ws1.Range("A2:A100"))
ws2.Range("A2:D65536").ClearContents

For i = 0 To WorksheetFunction.Min(65536, (-1 + k ^ 3))
    ws2.Range("B" & 2 + i).Value = ws1.Range("A" & 2 + Int(i / k ^ 2)).Value
    ws2.Range("C" & 2 + i).Value = ws1.Range("B" & 2 + i Mod k).Value
    ws2.Range("D" & 2 + i).Value = ws1.Range("C" & 2 + Int(i / k) Mod k).Value
    ws2.Range("A" & 2 + i).Value = ws2.Range("B" & 2 + i).Value & ws2.Range("C" & 2 + i).Value & ws2.Range("D" & 2 + i).Value
    Next i

End Sub

[nilem]

option

Sub ert()
Dim a, b, c, aa, bb, cc, x(), i&
With Sheets("parameters")
    With .Range("A2:C" & .Cells(Rows.Count, 1).End(xlUp).Row)
        aa = .Columns(1).Value: bb = .Columns(2).Value: cc = .Columns(3).Value
    End With
End With
ReDim x(1 To UBound(aa) ^ 3, 1 To 4)
For Each a In aa
    For Each b In bb
        For Each c In cc
            i = i + 1: x(i, 1) = a & b & c
            x(i, 2) = a: x(i, 3) = b: x(i, 4) = c
Next: Next: Next
Sheets("results").Range("A2:D2").Resize(i).Value = x()
End Sub

[edarevalo]

Thank you very much zbor. This is the macro I need! However, I just need the minor problem comes when the parameters are not of the same numbers or values (i.e. 8 Location IDs, 6 Structure ID, 10 Biz codes).
The result shows blanks, and there's a case that not all biz codes will be reflected.
sample2.xlsm

[zbor]

You can delete entire row with blank cells:

Sub combinate_data()
Dim ws1 As Worksheet, ws2 As Worksheet
Dim i As Long, k As Long

Set ws1 = Sheets("parameters")
Set ws2 = Sheets("results")

k = ws1.UsedRange.Rows.Count

ws2.Range("A2:D65536").ClearContents

For i = 0 To WorksheetFunction.Min(65536, (k ^ 3)) - 1
    ws2.Range("B" & 2 + i).Value = ws1.Range("A" & 2 + Int(i / k ^ 2)).Value
    ws2.Range("C" & 2 + i).Value = ws1.Range("B" & 2 + i Mod k).Value
    ws2.Range("D" & 2 + i).Value = ws1.Range("C" & 2 + Int(i / k) Mod k).Value
    ws2.Range("A" & 2 + i).Value = ws2.Range("B" & 2 + i).Value & ws2.Range("C" & 2 + i).Value & ws2.Range("D" & 2 + i).Value
    Next i

ws2.Columns("B:B").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
ws2.Columns("C:C").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
ws2.Columns("D:D").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End Sub

[edarevalo]

works flawlessly! Thank you very much!