ich möchte ab Zeile 2 die Zeilen markieren die gleichen Zelleninhalt in Spalte G haben, dann die Sortierung anwenden. Danach die nächste Zeilen markieren die gleichen Zelleninhalt haben und wieder die Sortierung anwenden. usw...
Die Routine soll enden, wenn in Spalte G die Zellen ohne Ihnalt kommt.
Mir fehlt in der Routine der Abschnitt mit markieren der Zeilen. Was muss ich ändern?
Sub Sortierung_Zeilen_Multi_3()
Dim r As Integer
'xlDescending = absteigend
'xlAscending = aufsteigend
r = Selection.Row
Cells.Select
Selection.sort _
Key1:=Range("F2"), Order1:=xlAscending, _
Key2:=Range("G2"), Order2:=xlAscending, _
Key3:=Range("I2"), Order3:=xlAscending, _
Header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal, DataOption2:=xlSortNormal, DataOption3:=xlSortTextAsNumbers
'Zeilen markieren....
Select Case Range("G" & r).Value
'Wenn in markierten Zeilenbereich in erste Zeile des markierten Zeilenbereiches in Spalte G
'dies "TX" steht, dann soll diese Sortierung angewendet werden:
Case "TX":
Selection.sort _
Key1:=Range("I" & ActiveCell.Row), Order1:=xlAscending, _
Key2:=Range("B" & ActiveCell.Row), Order1:=xlAscending, _
Key3:=Range("H" & ActiveCell.Row), Order3:=xlAscending, Header:=xlGuess
'Wenn in markierten Zeilenbereich in erste Zeile des markierten Zeilenbereiches in Spalte G
'dies "FT" steht, dann soll diese Sortierung angewendet werden:
Case "FT":
Selection.sort _
Key1:=Range("I" & ActiveCell.Row), Order1:=xlAscending, _
Key2:=Range("C" & ActiveCell.Row), Order1:=xlAscending, _
Key3:=Range("R" & ActiveCell.Row), Order3:=xlAscending, Header:=xlGuess
'Wenn in markierten Zeilenbereich in erste Zeile des markierten Zeilenbereiches in Spalte G
'dies "CT" steht, dann soll diese Sortierung angewendet werden:
Case "CT":
Selection.sort _
Key1:=Range("T" & ActiveCell.Row), Order1:=xlAscending, _
Key2:=Range("R" & ActiveCell.Row), Order1:=xlAscending, _
Key3:=Range("A" & ActiveCell.Row), Order3:=xlAscending, Header:=xlGuess
End Select
End Sub
Vielen Dank im Voraus.
Liebe Grüße
Selma