Excel transpose

[Hansraj]

Hi Sir
I have mentioned below table:
[TABLE="width: 325"]
<tbody>[TR]
[TD]ORDER_NO
[/TD]
[TD]Reason For Rejection
[/TD]
[/TR]
[TR]
[TD]4532599
[/TD]
[TD]Allocation Stock
[/TD]
[/TR]
[TR]
[TD]
[/TD]
[TD]Mismatch Packing
[/TD]
[/TR]
[TR]
[TD]
[/TD]
[TD]Surplus
[/TD]
[/TR]
[TR]
[TD]
[/TD]
[TD](blank)
[/TD]
[/TR]
[TR]
[TD]4535662
[/TD]
[TD](blank)
[/TD]
[/TR]
[TR]
[TD]4535724
[/TD]
[TD]Unavailability of Stock
[/TD]
[/TR]
[TR]
[TD]4535729
[/TD]
[TD]Allocation Stock
[/TD]
[/TR]
[TR]
[TD]
[/TD]
[TD]Unavailability of Stock
[/TD]
[/TR]
[TR]
[TD]
[/TD]
[TD](blank)
[/TD]
[/TR]
[TR]
[TD]4535738
[/TD]
[TD]Allocation Stock
[/TD]
[/TR]
[TR]
[TD]
[/TD]
[TD]Mismatch Packing
[/TD]
[/TR]
[TR]
[TD]
[/TD]
[TD](blank)
[/TD]
[/TR]
</tbody>[/TABLE]

And I want result as mention below:

[TABLE="width: 584"]
<tbody>[TR]
[TD][TABLE="width: 523"]
<tbody>[TR]
[TD]ORDER_NO
[/TD]
[TD]Reason For Rejection
[/TD]
[TD]Reason For Rejection
[/TD]
[TD]Reason For Rejection
[/TD]
[TD]Reason For Rejection
[/TD]
[/TR]
[TR]
[TD]4532599
[/TD]
[TD]Allocation Stock
[/TD]
[TD]Mismatch Packing
[/TD]
[TD]Surplus
[/TD]
[TD](blank)
[/TD]
[/TR]
[TR]
[TD]4535662
[/TD]
[TD](blank)
[/TD]
[TD]
[/TD]
[TD]
[/TD]
[TD]
[/TD]
[/TR]
[TR]
[TD]4535724
[/TD]
[TD]Unavailability of Stock
[/TD]
[TD]
[/TD]
[TD]
[/TD]
[TD]
[/TD]
[/TR]
[TR]
[TD]4535729
[/TD]
[TD]Allocation Stock
[/TD]
[TD]Unavailability of Stock
[/TD]
[TD](blank)
[/TD]
[TD]
[/TD]
[/TR]
[TR]
[TD]4535738
[/TD]
[TD]Allocation Stock
[/TD]
[TD]Mismatch Packing
[/TD]
[TD](blank)
[/TD]
[TD]
[/TD]
[/TR]
</tbody>[/TABLE]
[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]
[/TD]
[/TR]
</tbody>[/TABLE]

Thanks
Hansraj

 

[Special-K99]

Try this

Sub TransTable()
Lastrow = Worksheets("Sheet1").Cells(Rows.Count, "B").End(xlUp).Row
j = ""
k = 0
For i = 2 To Lastrow
If Worksheets("Sheet1").Cells(i, 1) = "" Then
  l = j: m = m + 1
Else
  l = Worksheets("Sheet1").Cells(i, 1)
  m = 2
  k = k + 1
  Worksheets("Sheet2").Cells(k, 1) = l
End If
j = l
Worksheets("Sheet2").Cells(k, m) = Cells(i, 2)
Next i
End Sub