Sort Problem

Hi,

I have problem when sorting.
I want to sorting by column AA, then I just need the top 5 data.
How I do it with VBA?
You can see data and result in the attachment.

Thanx for helping me.

pls check the range as I took only from you sheet...

many thanks
Rishi Saw

ActiveWorkbook.Worksheets("DATA").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("DATA").Sort.SortFields.Add Key:=Range("AA2:AA23") _
        , SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("DATA").Sort
        .SetRange Range("A1:AA23")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Range("B7").Select
    Range(Selection, Selection.End(xlDown)).Select
    Rows("7:23").Select
    Range("B7").Activate
    Selection.Borders(xlLeft).LineStyle = xlNone
    Selection.Borders(xlRight).LineStyle = xlNone
    Selection.Borders(xlTop).LineStyle = xlNone
    Selection.Borders(xlBottom).LineStyle = xlNone
    Selection.Delete Shift:=xlUp
    Range("A8").Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Range("A8:AA20").Select
    ActiveCell.FormulaR1C1 = "s"
    ActiveWorkbook.Worksheets("DATA").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("DATA").Sort.SortFields.Add Key:=Range("AA9:AA20") _
        , SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("DATA").Sort
        .SetRange Range("A8:AA20")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Range("A14:AA14").Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Range("A14:AA20").Select
    Selection.Delete Shift:=xlUp
    Range("A13").Select
End Sub

If the range always change (data always change every month), that means i must change the macro every time i used that?

Thanx

Hi rainbowzzzzz,
try it

Sub ertert()
Dim r As Range, i&
For Each r In ActiveSheet.UsedRange.Columns(27).SpecialCells(2).Areas    ' column AA
    With r.CurrentRegion
        .Offset(, 1).Resize(, .Columns.Count - 1).Sort Key1:=.Cells(1, 27), Order1:=xlDescending, Header:=xlYes
        i = .Rows.Count - 6
        If i > 0 Then .Offset(6).Resize(.Rows.Count - 6).EntireRow.Delete
    End With
Next r
End Sub

Hi Nilem,

It's work perfectly.

Thanx for ur help.