CODEWITHSUNDEEP
vbaexceltranspose
surya adhi
surya adhi

Reputation: 11

VBA/ Macro to transpose simple Table

i want to ask about VBA since i new in VBA coding, can you suggest me for problem below :

I Have Table like

enter image description here

Source

I Want to transpose all the data become :

enter image description here

Thanks for your suggestion. Godspeed

Upvotes: 1

Views: 583

Answers (1)

Subodh Tiwari sktneer
Subodh Tiwari sktneer

Reputation: 9976

Please give this a try...

'************************************************************************
'The code will work like this
'1) UnPivot the data on Sheet1
'2) Insert a New Sheet called Tranposed if not available in the workbook
'3) Place the output i.e. UnPivoted data on the Transposed Sheet.
'************************************************************************

Sub UnPivotData()
    Dim wsSource As Worksheet, wsDest As Worksheet
    Dim x, y, i As Long, j As Long, n As Long

    'Assuming your raw data is on a sheet called "Sheet1", change it if required
    Set wsSource = Sheets("Sheet1")

    x = wsSource.Cells(1).CurrentRegion.Value
    ReDim y(1 To UBound(x, 1) * UBound(x, 2), 1 To 2)

    For i = 2 To UBound(x, 1)
        For j = 2 To UBound(x, 2)
            If x(i, j) <> "" Then
                n = n + 1
                y(n, 1) = x(i, 1)
                y(n, 2) = x(i, j)
            End If
        Next
    Next

    On Error Resume Next
    Set wsDest = Sheets("Transposed")
    wsDest.Cells.Clear
    On Error GoTo 0

    If wsDest Is Nothing Then
        Sheets.Add(after:=wsSource).Name = "Transposed"
        Set wsDest = ActiveSheet
    End If
    wsDest.Range("A1:B1").Value = Array("Number", "Deatils")
    wsDest.Range("A2").Resize(UBound(y), 2).Value = y
    wsDest.Range("A1").CurrentRegion.Borders.Color = vbBlack
    MsgBox "Data Transposed Successfully.", vbInformation, "Done!"
End Sub

Upvotes: 1

Related Questions