T4072_Tabular Transpose By Arrays Columns First

https://excel-egy.com/forum/t4072
----------------------------------

Sub Tabular_Transpose_By_Arrays_Columns_First()
    Dim a, b, i As Long, j As Long, k As Long

    a = Sheets("Sheet1").Range("A3:D" & Sheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row).Value
    ReDim b(1 To UBound(a, 1) * 3, 1 To 2)
    k = 1

    For j = LBound(a, 2) + 1 To UBound(a, 2)
        For i = LBound(a, 1) To UBound(a, 1)
            If Not IsEmpty(a(i, j)) Then
                b(k, 1) = a(i, 1)
                b(k, 2) = a(i, j)
                k = k + 1
            End If
        Next i
    Next j

    With Sheets("Sheet1").Range("K1")
        .Resize(, UBound(b, 2)).Value = Array("Month", "Value")
        .Offset(1).Resize(UBound(b, 1), UBound(b, 2)).Value = b
    End With
End Sub