Wednesday, September 28, 2011

Transpose Data :

If you have data in Excel Sheet like :
Application.screenUpdating=false
Sub CreateList()
    Dim rngRange    As Range
    Dim rngCell     As Range
    Dim rngCell2    As Range
    Dim bytCol      As Byte
    Set rngRange = Range("A1:A" & Range("A" & Rows.Count).End(xlUp).Row)
    rngRange.Copy Range("C1")
    Range("A:B").Sort key1:=Range("A1")
    Range("C:C").RemoveDuplicates 1
    bytCol = 1
        For Each rngCell In Range("C1:C" & Range("C" & Rows.Count).End(xlUp).Row)
                For Each rngCell2 In rngRange
                       If rngCell2.Value = rngCell.Value Then
                            rngCell.Offset(0, bytCol).Value = rngCell2.Offset(0, 1).Value
                            bytCol = bytCol + 1
                       End If
                Next rngCell2
                bytCol = 1
        Next rngCell
Application.screenUpdating=True           
End Sub

You can transpose this Data in this Way By using Mention Code: