Creating multiple rows from one row with multiple columns

[katkins0429]

Hi I have been searching your posts and found a VBA post to split one row into multiple rows, however I need something that will return a little different results. I am looking for some help with this.

I have uploaded my sample data with a data tab and a result tab.

I would like to copy specific columns until the entire row is copy down (basically in a database format), along with the headings copying down in the last column.

I hope someone could help me.
Thanks for your help
UPLOADTEST1.xlsm

[jindon]

Try

Sub test()
    Dim a, b, i As Long, ii As Long, iii As Long, n As Long
    a = Sheets("data").Cells(1).CurrentRegion.Value
    ReDim b(1 To UBound(a, 1) * UBound(a, 2), 1 To 5)
    n = n + 1
    For i = 1 To 3
        b(n, i) = a(1, i + IIf(i < 3, 0, 1))
    Next
    b(n, 4) = "price": b(n, 5) = "month"
    For i = 2 To UBound(a, 1)
        For ii = 5 To UBound(a, 2)
            n = n + 1
            For iii = 1 To 3
                b(n, iii) = a(i, iii + IIf(iii < 3, 0, 1))
            Next
            b(n, 4) = a(i, ii)
            b(n, 5) = a(1, ii)
        Next
    Next
    With Sheets("results").Cells(1).Resize(n, 5)
        .CurrentRegion.ClearContents
        .Value = b
    End With
End Sub

[Winon]

@ jindon,

Nice as always!

But your Code copies the Results 18 times instead of only once?

[jindon]

@ jindon,

But your Code copies the Results 18 times instead of only once?

I don't know what you mean but I read the problem as my result.

[Winon]

@ jindon,

What I am trying to say is that your Code Copies the Results over and over down to Row 127 instead of down to Row 8 only.

[jindon]

7 (column E to K) * 18 (rows) makes 126 rows + heading = 128

That's how I read the problem

[Winon]

@ jindon,

Sorry jindon,

You are right.

I did not notice the OP gave us a short example of the Results he is after.

Your Code is flawless!

[katkins0429]

Thank you so much it worked

[katkins0429]

Thank you again for this code.