Codeergänzung sortieren
WalterK
vor einiger Zeit habe ich den nachstehenden Code im Forum erhalten. Er fügt (falls bestimmte Bedingungen erfüllt) sind eine Spalte ein, fügt die Daten von 2 Spalten ein, löscht die beiden "alten" Spalten, benennt die Überschrift um und sortiert als letztes die Tabelle nach der eingefügten Spalte. Die Überschriften sind immer in Zeile 2. Funktioniert auch tadellos.
Ein kleine Ergänzung müsste noch umgesetzt werden:
Sollte vor dem letzten Schritt des Codes (dem Sortieren) unmittelbar rechts neben der "neuen" Spalte "VOR- UND ZUNAME" eine Spalte mit der Überschrift "BEGINN" oder "VON" oder "ANFANG" sein, dann sollte die Sortierung zuerst nach der Spalte "VOR- UND ZUNAME" und dann noch nach der Spalte "BEGINN" oder "VON" oder "ANFANG" erfolgen.
Wer kann mir weiterhelfen?
Hier ist der Code:
Dim varCol_ZUNAME As Variant, lngZeileLetzte As Long
varCol_ZUNAME = Application.Match("ZUNAME", Rows(2), 0)
If IsError(varCol_ZUNAME) Then Exit Sub
lngZeileLetzte = Cells(Rows.Count, CLng(varCol_ZUNAME)).End(xlUp).Row
If lngZeileLetzte < 3 Then Exit Sub
Columns(2).Insert shift:=xlShiftToRight
varCol_ZUNAME = Application.Match("ZUNAME", Rows(2), 0)
Columns(CLng(varCol_ZUNAME) - 1).Copy
Columns(2).PasteSpecial xlPasteFormats
Application.CutCopyMode = False
varCol_ZUNAME = Application.Match("ZUNAME", Rows(2), 0)
Range(Cells(3, 2), Cells(lngZeileLetzte, 2)).FormulaR1C1 = "=" & "RC[" & varCol_ZUNAME - 2 & _
"]&"" ""&RC[" & varCol_ZUNAME - 3 & "]"
Range(Cells(3, 2), Cells(lngZeileLetzte, 2)).Formula = Range(Cells(3, 2), Cells( _
lngZeileLetzte, 2)).Value
Range(Columns(CLng(varCol_ZUNAME) - 1), Columns(CLng(varCol_ZUNAME))).Delete
Cells(2, 2) = "VOR- UND ZUNAME"
Columns(2).AutoFit
Range("A3:IV65536").Select
Selection.Sort Key1:=Range("B3"), Order1:=xlAscending, Header:=xlNo, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Range("A2").Select
Danke und Servus, Walter
Anzeige