my VBA code needs an adjustment

Sub ToColumns()
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
End Sub

The data I receive has changed.
I believe the reason the code is not working is that the number of individual name entries in column A has increased to a maximum above 15, which is what i requested when this code was created.

If someone has any any ideas I would be grateful.

sorry - this is the correct code

Sub ToColumns()
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
End Sub

That code doesn't appear to be limited (to 15 of anything).

What does it do or not do that it didn't do or did do before? Is there an error message? If so, what is it and on which line does it occur?

It would probably help a lot if you uploaded a sample workbook and explain the problem in more detail.

Regards, TMS

There's no code in the sample workbook provided. However, I've copied the code from an earlier post. Seems to work OK for me. Again, what is it doing that it shouldn't or not doing that it should?

Regards, TMS

Frankie,

I removed your posts where you were trying the tags out, to prevent other users from getting confused.

For vba code, you need to put code tags. See my signature on how to do so.

@Frankie: yep, that's exactly what it does ... but some rows have zero values.

HTML Code: 

Regards, TMS

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

You're welcome. Thanks for the rep.

I have marked this thread solved for you.
In the future please select Thread Tools from the menu above and mark the thread as solved. Thanks.