Ineffizienter Sorting Code für großen Datensatz

Sub aufgerufen und die Ergebnisse werden dann in einer Binärmatrix (1=True und 0=FALSE) auf  _
einem weiteren Sheet vermerkt.
Die Funktion funktioniert einwandfrei, nur ist der Code zu ineffizient. Es dauert viel zu lange  _
(> 15 Minuten), um das für alle Spalten und alle Zeilen zu berechnen und ich würde mich über
Anregungen und Vorschläge freuen, die mir helfen, den Code schneller laufen zu lassen.
Hier mein Code:

Function check_top5(ByVal spalte_name As String)
Dim e As Integer
Dim boo As Boolean
boo = False
'Das hier schreibt in ein Hilfsblatt "sheet5" alle 7 Werte der jeweiligen Zeile untereinander  _
in Spalte A und in Spalte B die Benennung der jeweiligen Spalten, um die Werte zuordnen zu können.
For e = 1 To 7
col_nr = e * 6
Sheet5.Range("A" & e) = Sheet3.Range("A" & 201).Offset(0, col_nr)
'im Blatt "Sheet3" ist der ganze Datensatz gespeichert
Sheet5.Range("B" & e) = Sheet3.Range("A1").Offset(0, col_nr).Offset(0, -5)
Next e
'Dieser Teil sortiert die 7 Werte im Hilfsblatt "sheet" (=Sheet5) absteigend, um von oben  _
einfach die 5 größten Werte abzählen zu können.
Columns("A:A").Select
ActiveWorkbook.Worksheets("sheet").sort.SortFields.Clear
ActiveWorkbook.Worksheets("sheet").sort.SortFields.Add Key:=Range("A1"), _
SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("sheet").sort
.SetRange Range("A1:B7")
.Header = xlNo
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
'Dieser Code überprüft, ob der Name der einzelne Spalte, die in diesem Aufruf der Funktion  _
betrachtet wird, unter den top 5 größten Werte ist. Falls dies der Fall ist, gibt "boo" der Funktion den Wert TRUE.
Andernfalls den Wert FALSE.
For i = 1 To 5
If Sheet5.Range("B" & i) = spalte_name Then
boo = True
End If
Next i
check_top5 = boo
End Function