transpose repeating range of matrix using Excel vba

Question

I have a situation where I have multiple groups of matrix that I would like to transpose and would like some help with Excel vba code. Thank you in advance for your help.

My table is as follows-(it will be 13 month view but I'm showing only 3 for this sample)

Group   month   color   shape   cost
A       Jan      B        S         1
A       Feb      G        T         2
A       Mar      Y        R         3
B       Jan      W        C         5
B       Feb      M        S         4
B       Mar      P        R         7

and so on (more groups and more months) Desired result---

Group       Jan Feb Mar
A   color   B   G   Y   
    shape   S   T   R
    cost    1   2   3
B   color   W   M   P
    shape   C   S   R
    cost    5   4   7

and so on (with their values transposed)

sample code not exactly giving the above result but something I have used to start with.

Sub transposedata()
Dim vcol1 As Variant, vcol2 As Variant, vcol3 As Variant, vcol4 As Variant, vcol5 As Variant, vcol6 As Variant
Dim lastrow As Long
Dim ws As Worksheet


Set ws = Sheets(1)

lastrow = ws.Cells(ws.Rows.Count, "B").End(xlUp).Row

lastrow = lastrow - 1

vcol1 = WorksheetFunction.transpose(ws.Range("B2").Resize(lastrow).Value)
vcol2 = WorksheetFunction.transpose(ws.Range("C2").Resize(lastrow).Value)
vcol3 = WorksheetFunction.transpose(ws.Range("D2").Resize(lastrow).Value)
vcol4 = WorksheetFunction.transpose(ws.Range("E2").Resize(lastrow).Value)
vcol5 = WorksheetFunction.transpose(ws.Range("F2").Resize(lastrow).Value)
vcol6 = WorksheetFunction.transpose(ws.Range("G2").Resize(lastrow).Value)

ws.Range("J2").Resize(1, UBound(vcol1)) = vcol1
ws.Range("J3").Resize(1, UBound(vcol1)) = vcol2
ws.Range("J4").Resize(1, UBound(vcol1)) = vcol3
ws.Range("J5").Resize(1, UBound(vcol1)) = vcol4
ws.Range("J6").Resize(1, UBound(vcol1)) = vcol5
ws.Range("J7").Resize(1, UBound(vcol1)) = vcol6

End Sub

Answer 1

Tested:

Sub Pivot()
    Const NUM_MONTHS As Long = 3
    Const NUM_PROPS As Long = 3

    Dim rng As Range, rngDest As Range, arrProps, x

    'first block of source data
    Set rng = Sheets("Sheet1").Range("A2").Resize(NUM_MONTHS, 5)

    'header labels
    arrProps = Application.Transpose(rng.Rows(1).Offset(-1, 0). _
                              Cells(3).Resize(1, NUM_PROPS).Value)

    'top-left of destination table
    Set rngDest = Sheets("Sheet1").Range("J1")

    'set up headers
    With rngDest
        .Value = "Group"
        .Offset(0, 1).Value = "property"
        .Offset(0, 2).Resize(1, NUM_MONTHS).Value = _
                Application.Transpose(rng.Columns(2).Value)
    End With
    Set rngDest = rngDest.Offset(1, 0)

    'copy data
    Do While rng.Cells(1).Value <> ""
        rngDest.Value = rng.Cells(1, 1).Value 'group
        'property names
        rngDest.Offset(0, 1).Resize(NUM_PROPS, 1).Value = arrProps

        'property values
        For x = 1 To NUM_PROPS
            rngDest.Offset(x - 1, 2).Resize(1, NUM_MONTHS).Value = _
                Application.Transpose(rng.Columns(2 + x).Value)
        Next x

        'move to next block
        Set rng = rng.Offset(NUM_MONTHS, 0)
        Set rngDest = rngDest.Offset(3, 0)
    Loop
End Sub