Этот макрос не только сортирует, но и делает СУММУ:
Private Sub Worksheet_Change(ByVal Target As Range)
Application.ScreenUpdating = False
Application.EnableEvents = False
Dim wkb As Workbook
Set wkb = ThisWorkbook
Dim wks, wks1 As Worksheet
Set wks = wkb.Worksheets("Sheet1") ' Sheet with the results
Set wks1 = wkb.Worksheets("Sheet2") ' Sheet with the totals
wks1.Rows.Clear ' Clear the contents of Sheet2
wks1.Cells(1, 2) = "TOTAL"
usedcolumns = True
thecolumn = 1
totalrow = 2
While usedcolumns
therow = 1
totalpoints = 0
usedrows = True
While usedrows
thedata = wks.Cells(therow, thecolumn)
If thedata <> "" Then
If therow = 1 Then
teamname = thedata
Else
totalpoints = totalpoints + thedata
End If
therow = therow + 1
Else
usedrows = False
If therow = 1 Then usedcolumns = False
End If
Wend
If teamname <> "" Then
wks1.Cells(totalrow, 1) = teamname
wks1.Cells(totalrow, 2) = totalpoints
teamname = ""
totalpoints = 0
thecolumn = thecolumn + 1
totalrow = totalrow + 1
End If
Wend
lastrow = wks1.Cells(Rows.Count, 2).End(xlUp).Row
With wks1
.Range("A1:B" & lastrow).Sort key1:=.Range("B2:B" & lastrow), order1:=xlDescending, Header:=xlYes
End With
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
Перейдите к VBA /Macros с помощью alt+ F11 и дважды щелкните по Sheet1
, затем вставьте этот код с правой стороны.
Чтобы избежать любой потенциальной проблемы, которая может возникнуть, если когда-нибудь макрос вызовет ошибку, заблокировав обнаружение событий в книге, дважды щелкните по This Workbook
и вставьте это:
Private Sub Workbook_Open()
Application.EnableEvents = True
End Sub