Vb macro coding for transpose - complete coding?

Originally Posted by Dharani Suresh

Dear John H.Davis,

Thank for the quick response...
but the code is not giving the required output... pls help me by doing some modifications... for easy understanding of the output, please refer the attached excel file, in that I did manually...

Maybe:

Sub DharaniSuresh()
Dim i As Long
Application.ScreenUpdating = False
Range("I3").Value = "FINAL OUTPUT:"
Range("I3").Font.Bold = True
For i = ActiveSheet.UsedRange.Rows.count + 1 To 4 Step -1
    If Range("A" & i).Value <> Range("A" & i).Offset(1).Value Then
        Range("A" & i).Offset(1).EntireRow.Insert xlDown
    End If
Next i
Range("A4").Select
Do Until ActiveCell.Value = "" And ActiveCell.Offset(1).Value = ""
x = 10
ActiveCell.Copy Range("I" & Rows.count).End(3)(2)
Do Until ActiveCell.Value = ""
    ActiveCell.Offset(, 2).Copy Cells(Range("I" & Rows.count).End(3)(2).Row - 1, x)
    x = x + 1
    ActiveCell.Offset(1).Select
Loop
If ActiveCell.Value = "" And ActiveCell.Offset(1).Value <> "" Then
    ActiveCell.Offset(1).Select
End If
Loop
Range(Cells(4, 9), Cells(ActiveSheet.UsedRange.Rows.count, ActiveSheet.UsedRange.Columns.count)).Font.ColorIndex = 1
Range("A4:C" & ActiveSheet.UsedRange.Rows.count + 1).SpecialCells(xlCellTypeBlanks).Delete xlUp
Application.ScreenUpdating = True
End Sub