Verschiedene Sortierung auf zwei Tabellenblättern
03.08.2018 09:57:54
Anni
ich habe ein Problem.
Mit Hilfe von Rob und Daniel habe ich ein Makro zum Erstellen einer Bestellhistorie erstellt. Den ganzen Thread findet ihr hier.
Jetzt bleibt mir aber noch ein Problem. Nachdem die bestellten Artikel in die Historie übertragen wurden, möchte ich auf beiden Tabellenblättern Sortierungen unter verschiedenen Kriterien anwenden. Auf Tabellenblatt 2 ("Historie") klappt das perfekt, aber auf Tabellenblatt 1 ("Eingangskontrolle") nicht.
Hier mal der komplette Code:
Sub Historie2()
Dim r As Range
For Each r In Range("A2:A" & Cells(Rows.Count, 6).End(xlUp).Row)
If r = "x" Then
If r.Offset(0, 1) "" And r.Offset(0, 3) "" And r.Offset(0, 4) "" Then
r.EntireRow.Copy Sheets("Historie").Range("A" & Sheets("Historie").Cells(Rows.Count, _
_
_
_
1).End(xlUp).Row + 1)
Range(Cells(r.Row, 1), Cells(r.Row, 5)).ClearContents
End If
End If
If r = "x" Then
If r.Offset(0, 1) = "" Or r.Offset(0, 3) = "" Or r.Offset(0, 4) = "" Then
MsgBox "Kein Übertrag in die Bestell-Historie für Zeile " & r.EntireRow.Address & _
" möglich, da Spalte B, D oder E leer! Spalten füllen und Button erneut drücken!", _
_
_
vbInformation
End If
End If
ActiveWorkbook.Worksheets("Historie").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Historie").Sort.SortFields.Add Key:=Range("F1, H1, E1") _
, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Historie").Sort
.SetRange Range("A1").CurrentRegion
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Worksheets("Eingangskontrolle").Activate
ActiveWorkbook.Worksheets("Eingangskontrolle").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Eingangskontrolle").Sort.SortFields.Add Key:=Range("B1, F1, G1, _
_
_
H1") _
, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Eingangskontrolle").Sort
.SetRange Range("A1").CurrentRegion
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Next r
End Sub
Lieben Dank im Voraus.