Option Explicit

Sub ToColumns_TMS()

Dim lLR As Long
lLR = Range("A" & Rows.Count).End(xlUp).Row

Application.ScreenUpdating = False
With Range("A1")
    .AutoFilter
    With Range("$A$2:$B" & lLR)
        .AutoFilter _
            Field:=2, _
            Criteria1:="0"
        .Delete Shift:=xlUp
    End With
    .AutoFilter
End With

Dim Area As Range
Dim LastRow As Long, i As Long, aArea As Range

On Error Resume Next
Columns("B").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
On Error GoTo 0
LastRow = Cells(Rows.Count, "A").End(xlUp).Row
For i = LastRow To 2 Step -1
    If Range("A" & i).Value <> Range("A" & i - 1).Value Then
        Rows(i).Insert
    End If
Next i
For Each Area In Columns("B").SpecialCells(xlCellTypeConstants).Areas
    Area(1).Offset(, 1).Resize(, Area.Rows.Count).Value = Application.Transpose(Area)
Next Area
Columns("C").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
Columns("B").Delete

Range(Range("L1"), Cells(1, Columns.Count)).EntireColumn.Delete

Application.ScreenUpdating = True
End Sub


HTML Code: 

Regards, TMS