Aber das mittlere Stück macht er einfach nicht.
Hier ist mein Code, vielleicht weiss ejmand eine Lösung:
Option Explicit
Private Sub Worksheet_Calculate()
Application.EnableEvents = False
Call sorttab
Application.EnableEvents = True
End Sub
Sub sorttab()
Application.ScreenUpdating = False
With Sheets("GruppeA")
.[B46:n49].Copy .[B38:n41]
.[B38:n41].Sort Key1:=.[J38], Order1:=xlDescending, Key2:=.[i38], _
Order2:=xlDescending, Key3:=.[n39:n40], Order3:=xlDescending, Header:=xlGuess
End With
If Range("I52") = 2 Then Call direktvergleich_1
Application.ScreenUpdating = True
End Sub