Sorteren via code

[CorVerm]

Beste mensen,
Onderstaande code ben ik van de week tegen gekomen op het forum (het gedeelte met de blauwe letters), volgens mij van de hand van LucB.
Zoals je kunt zien heb ik de code verder uitgebreid omdat er in mijn situatie meerdere ranges moeten worden gesorteerd. Op zich werkt dat goed maar ik vraag mij af of de code zodanig aangepast kan worden dat de verschillende ranges, zeg maar, in 1 code kunnen worden gesorteerd. Elke range is wel gerangschikt van 1 t/m 4.

[COLOR="Navy"]Private Sub Worksheet_Change(ByVal Target As Range)

    If Target.Cells.Count > 1 Then Exit Sub
    Application.EnableEvents = False
    If Not Intersect(Target, Range("H4:I40")) Is Nothing Then
        Range("Q5:AA8").Sort Key1:=Range("AA5"), Order1:=xlAscending, Header:=xlGuess, _
                             OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
    End If
    Application.EnableEvents = True[/COLOR]
If Target.Cells.Count > 1 Then Exit Sub
    Application.EnableEvents = False
    If Not Intersect(Target, Range("H4:I40")) Is Nothing Then
        Range("Q10:AA13").Sort Key1:=Range("AA10"), Order1:=xlAscending, Header:=xlGuess, _
                             OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
    End If
    Application.EnableEvents = True
End Sub

 

[Cobbe]

In elk geval al korter:

Private Sub Worksheet_Change(ByVal Target As Range)
   If Target.Cells.Count > 1 Then Exit Sub
   Application.EnableEvents = False
   If Not Intersect(Target, Range("H4:I40")) Is Nothing Then
          Range("Q5:AA8").Sort Key1:=Range("AA5"), Order1:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
          Range("Q10:AA13").Sort Key1:=Range("AA10"), Order1:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
   End If
        Application.EnableEvents = True
   End Sub

Cobbe

 

[CorVerm]

Cobbe,
Zeer bedankt, zo was het inderdaad bedoelt.