Die Sortierroutine
10.01.2013 09:58:29
Matthias
Hallo Ernst
Das hatten wir aber alles schonmal
ins Modul
Public MyCol& '& = Long
Sub Sortieren_All()
On Error GoTo ErrExit
Application.ScreenUpdating = False
Application.EnableEvents = False
Select Case MyCol
Case Is = 1
Range("A7:D87").Sort Key1:=Range("A8"), Order1:=xlAscending, Header:=xlYes
Case Is = 6
Range("F7:I87").Sort Key1:=Range("F8"), Order1:=xlAscending, Header:=xlYes
Case Is = 11
Range("K7:P87").Sort Key1:=Range("K8"), Order1:=xlAscending, Header:=xlYes
End Select
ErrExit:
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
In die Tabelle
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("A8:A87,F8:F87,K8:K87")) Is Nothing Then
MyCol = Target.Column
MsgBox "spalte:" & MyCol & vbLf & "Ereignismakros werden jetzt deaktiviert"
Application.EnableEvents = False 'Ereignismakros deaktivieen
If Target = "" Then
Target.Offset(, 2) = ""
Target.Offset(, 3) = ""
Target.Interior.ColorIndex = -4142
Target.Offset(, 1).Interior.ColorIndex = -4142
End If
MsgBox "Sortiere jetzt ..."
Sortieren_All
MsgBox "Ereignismakros werden jetzt wieder aktiviert"
Application.EnableEvents = True 'Ereignismakros wieder aktivieren
End If
End Sub
Die kleinen Hinweisfenster(MsgBox) kannt Du dann ja alle löschen
https://www.herber.de/bbs/user/83322.xls
Gruß Matthias