Boa noite!!

Tente algo assim.

Sub AleVBA_22462()
    Dim MyRange As Range
    Dim iCounter As Long

    Set MyRange = ActiveSheet.UsedRange
    For iCounter = MyRange.Columns.Count To 1 Step -1
       If Application.CountA(Columns(iCounter).EntireColumn) < 2 Then
        Columns(iCounter).Delete
       End If
    Next iCounter
    Range("1:5").Delete
    Cells.Select
    ActiveWorkbook.Worksheets("Ste").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Ste").Sort.SortFields.Add Key:=Range("C2:C1623"), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Ste").Sort
        .SetRange Range("A1:AD1623")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
End Sub

Att

Boa noite!!

Essa macro está um pouco melhor..

Sub Macro1()
'
' Macro1 Macro
Dim col         As Long
Dim c           As Range
Dim i As Long

    Range("1:5").Delete
    ActiveWorkbook.Worksheets("Sheet2").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Sheet2").Sort.SortFields.Add Key:=Range("I2:I90000"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Sheet2").Sort
        .SetRange Range("A1:AD90000")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    
    col = Cells(1, Columns.Count).End(xlToLeft).Column

    For i = col To 1 Step -1
        If Cells(1, i).End(xlDown).Row = Rows.Count Then
            Columns(i).Delete
        End If
    Next
    Range("H:H, K:M, S:S").Delete
    [X1].Value = "AleVBA"
    With Range("X2:X9999")
        .Formula = "=IF(OR(COUNTIF(A2,""*""&""Local""&""*"")>0,COUNTIF(A2,""*""&""Página""&""*"")>0,COUNTIF(A2,""*""&""<Genérica>""&""*"")>0,COUNTIF(A2,""*""&""Edição Controlada Plantão Prg x Real""&""*"")>0),1,0)"
        .Value = .Value
    End With
    With Range("$A$1:$X$9999")
        .AutoFilter Field:=24, Criteria1:="1"
        .Resize(Rows.Count - 1).Offset(1).EntireRow.Delete
    End With
    ActiveSheet.AutoFilterMode = False

End Sub

Att

Olá alexandrevba,
Perfeito! Realizei os teste, ocorreu tudo certo. Muito obrigado.
Abraço!

Bom dia Anacleto

Neste tópico eu já mudei a marcação de Resolvido, mas nas próximas vezes, marque Resolvido na resposta que atendeu a tua dúvida.
Fazendo isso, quem tiver a mesa dúvida vai conseguir identificar qual a resposta que resolveu a dúvida.

[]s