Macro ändern (an Heiko S.)

Sub Auswerten2()
Dim strTeam As String, strSheetName As String
Dim lngLastRow As Long, lngI As Long, lngN As Long, lngTeamErsteZeile As Long
Dim intTeamCounter As Integer, intSpalte As Integer, intAusW As Integer
' Programm starten wenn die Ausgangstabelle auch das aktive Tabellenblatt ist !!!
ActiveSheet.UsedRange.Copy
ActiveWorkbook.Worksheets.Add After:=Sheets(Sheets.Count)
' Wenn schon ein Tabellenblatt mit dem namen Auswertung besteht, dann den von EXCEL vergebenen
' Namen beibehalten.
On Error Resume Next
ActiveSheet.Name = "Auswertung"
On Error GoTo 0
ActiveSheet.Paste Destination:=ActiveSheet.Range("A1")
strSheetName = ActiveSheet.Name
Application.CutCopyMode = False
lngTeamErsteZeile = 2
'Application.ScreenUpdating = False
With Worksheets(strSheetName)
lngLastRow = .Cells(Rows.Count, 1).End(xlUp).Row
.Range(Cells(1, 1), Cells(lngLastRow, 5)).Sort _
Key1:=Range("A1"), Order1:=xlAscending, Header:=xlYes, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
MsgBox "drin"
lngN = lngLastRow + 5
strTeam = UCase(.Cells(2, 1))
For lngI = 3 To lngLastRow + 1
If strTeam <> UCase(.Cells(lngI, 1)) Then
.Range(Cells(lngTeamErsteZeile, 1), Cells(lngI - 1, 5)).Sort _
Key1:=Range("E" & lngTeamErsteZeile), Order1:=xlDescending, Header:=xlNo, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
.Cells(lngN, 1) = .Cells(lngI - 1, 1)
intSpalte = 2
If lngI - lngTeamErsteZeile < 4 Then
intAusW = lngI - lngTeamErsteZeile - 1
Else
intAusW = 3
End If
For intTeamCounter = lngTeamErsteZeile To lngTeamErsteZeile + intAusW
.Range(Cells(intTeamCounter, 2), Cells(intTeamCounter, 5)).Copy _
Destination:=.Cells(lngN, intSpalte)
intSpalte = intSpalte + 4
Next intTeamCounter
lngN = lngN + 1
lngTeamErsteZeile = lngI
End If
strTeam = UCase(.Cells(lngI, 1))
Next lngI
Rows("1:" & lngLastRow + 2).Delete
End With
Application.ScreenUpdating = True
End Sub