HERBERS Excel-Forum - das Archiv
Liste automatisch neu erstellen und umsortieren
Markus

Hallo liebe Forumsteilnehmer,
ich benötige eure Hilfe bei folgendem Problem, welches ich gerne mit Excel lösen würde.
Ich habe eine Liste mit folgende Spalten und folgenden Beispieleinträgen
Lfd. Nr. Name1 Name2 Name3 Bemerkung Ablageort
001 A B C Larum Leitz
002 Z W X Lirum Leitz
003 usw.
004 usw.
Die Liste wird ständig erweitert. Nun zum Problem: Über ein Makro hätte ich gerne eine zweite Tabelle
automatisch geöffnet die auf der Grundlage der vorgenannten Daten folgendes erzeugt:
Lfd. Nr. Name1 Name2 Name3 Bemerkung Ablageort
001 A B C Larum Leitz
001 B A C Larum Leitz
001 C A B Larum Leitz
002 W X Z Lirum Leitz
002 X W Z Lirum Leitz
002 Z X W Lirum Leitz
Also aus den Spalten Name1, Name2 und Name3 soll jeweils jeder Eintrag einmal alphabetisch sortiert unter Name1 erscheinen und daneben dann Name2 und Name 3, sowie unverändert Bemerkung und Ablageort.
Hat vielleicht jemand eine Lösunsgidee?
Beste Grüße
Markus

AW: Liste automatisch neu erstellen und umsortiere
ChrisL

Hallo Markus
Probier mal...


Sub Makro1()
Dim WS1 As Worksheet, WS2 As Worksheet
Dim i As Long, LetzteZeile1 As Long, LetzteZeile2 As Long
Set WS1 = Worksheets("Tabelle1")
Set WS2 = Worksheets("Tabelle2")
WS2.Rows("2:65536").Delete
LetzteZeile1 = WS1.Range("A65536").End(xlUp).Row
For i = 2 To LetzteZeile1
LetzteZeile2 = WS2.Range("A65536").End(xlUp).Row + 1
WS2.Cells(LetzteZeile2, 1) = WS1.Cells(i, 1)
WS2.Cells(LetzteZeile2 + 1, 1) = WS1.Cells(i, 1)
WS2.Cells(LetzteZeile2 + 2, 1) = WS1.Cells(i, 1)
WS2.Cells(LetzteZeile2, 2) = WS1.Cells(i, 2)
WS2.Cells(LetzteZeile2 + 1, 2) = WS1.Cells(i, 3)
WS2.Cells(LetzteZeile2 + 2, 2) = WS1.Cells(i, 4)
WS2.Cells(LetzteZeile2, 3) = WS1.Cells(i, 3)
WS2.Cells(LetzteZeile2 + 1, 3) = WS1.Cells(i, 2)
WS2.Cells(LetzteZeile2 + 2, 3) = WS1.Cells(i, 2)
WS2.Cells(LetzteZeile2, 4) = WS1.Cells(i, 4)
WS2.Cells(LetzteZeile2 + 1, 4) = WS1.Cells(i, 4)
WS2.Cells(LetzteZeile2 + 2, 4) = WS1.Cells(i, 3)
WS2.Cells(LetzteZeile2, 5) = WS1.Cells(i, 5)
WS2.Cells(LetzteZeile2 + 1, 5) = WS1.Cells(i, 5)
WS2.Cells(LetzteZeile2 + 2, 5) = WS1.Cells(i, 5)
WS2.Cells(LetzteZeile2, 6) = WS1.Cells(i, 6)
WS2.Cells(LetzteZeile2 + 1, 6) = WS1.Cells(i, 6)
WS2.Cells(LetzteZeile2 + 2, 6) = WS1.Cells(i, 6)
Next i
End Sub


Gruss
chris

AW: Liste automatisch neu erstellen und umsortiere
Markus

Hallo Chris,
allerbesten Dank, es funktioniert! Ich habe schon lange nach der Lösung gesucht.
Vielleicht hast du noch einen Zusatztipp:
Die Auswertungssliste soll nach der Spalte "Name1" sortiert werden von A-Z. Geht zwar einfach über die Sortierung von Excel, aber automatisch mit dem Makro wäre es super.
Schöne Grüße
Markus

AW: Liste automatisch neu erstellen und umsortiere
Herby

Hallo Markus,
probier mal:


Sub sortieren()
Dim lZ As Long
lZ = Worksheets("Tabelle2").Range("A65536").End(xlUp).Row
Worksheets("Tabelle2").Range("A1:F" & lZ).Sort Key1:=Range("B2"), Order1:=xlAscending, Key2:= _
Range( _
"C2"), Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase _
:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, _
DataOption2:=xlSortNormal
End Sub


Ich habs mit dem Makrorecorder aufgezeichnet.
viele Grüße
Herby

AW: Liste automatisch neu erstellen und umsortiere
Herby

Hallo Markus,
probier mal:


Sub sortieren()
Dim lZ As Long
lZ = Worksheets("Tabelle2").Range("A65536").End(xlUp).Row
Worksheets("Tabelle2").Range("A1:F" & lZ).Sort Key1:=Range("B2"), Order1:=xlAscending, Key2:= _
Range("C2"), Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase _
:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, _
DataOption2:=xlSortNormal
End Sub


Ich habs mit dem Makrorecorder aufgezeichnet.
viele Grüße
Herby

AW: Liste automatisch neu erstellen und umsortiere
Wells

Hallo Herby,
spät aber besser spät als nie. Besten Dank die Sortierung funktioniert einwandfrei.
Schöne Grüße
Markus