Sub Try_This_A()
    Dim lc As Long, lr As Long
    lc = Cells.Find("*", SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
    lr = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    Application.ScreenUpdating = False
    With Range(Cells(1, 1), Cells(lr, lc))
        .SpecialCells(4).Delete -4162
    End With
    Rows("1:1").Insert Shift:=xlDown
    Range(Cells(1, 1), Cells(1, lc)).FormulaR1C1 = "=COUNTA(R[2]C:R[15]C)"
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add Key:=Range(Cells(1, 1), Cells(1, lc)), _
        SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Sheet1").Sort
        .SetRange Range(Cells(1, 1), Cells(lr + 1, lc))
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlLeftToRight
        .SortMethod = xlPinYin
        .Apply
    End With
    Rows("1:1").Delete
    Application.ScreenUpdating = False
End Sub