Live-Forum - Die aktuellen Beiträge
Datum
Titel
17.04.2024 21:55:37
Preiserhöhung über mehrere Jahre berechnen
17.04.2024 20:19:32
Endzeitpunkt berechnen aus d:hh:mm errechnen
17.04.2024 18:57:33
Errinnerungsfunktion
17.04.2024 16:56:58
Stunden addieren
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
1296to1300
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
1296to1300
1296to1300
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Bestimmte Daten in gleichnamiges Registerblatt sor

Bestimmte Daten in gleichnamiges Registerblatt sor
04.02.2013 21:57:09
Marco
Hallo,
bin Anfänger was Sachen VBA-Programmierung betrifft.
Habe hier mal eine Testdatei:

Die Datei https://www.herber.de/bbs/user/83754.xlsm wurde aus Datenschutzgründen gelöscht

Was soll das Makro machen:
Es soll nur die Zeilen ( Spalte A,B und C ), die in den Spalten A-L durch ein X gekennzeichnet werden, in das gleichnamige Registerblatt ( A-L ) kopiert, bzw. sortiert werden. Das Makro soll per Button gestartet werden.
Hoffe ich habe mich verständlich ausgedrückt, und mir kann jemand behilflich sein.
Gruß
Marco

9
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Bestimmte Daten in gleichnamiges Registerblatt sor
05.02.2013 07:34:01
haw
Hallo Marco,
siehe auch Datei: https://www.herber.de/bbs/user/83757.xlsm 
Sub Übertragen()
Dim ws As Worksheet, wsÜ As Worksheet, lz&, i&, efz&, gef As Range
Set wsÜ = ThisWorkbook.Worksheets("Übersicht")
lz = wsÜ.Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To lz
Set gef = wsÜ.Rows(i).Find("X", LookAt:=xlWhole)
If Not gef Is Nothing Then
Set ws = ThisWorkbook.Worksheets(wsÜ.Cells(1, gef.Column).Value)
If ws.Range("A1").Value = "" Then wsÜ.Range("A1:C1").Copy ws.Range("A1")
efz = ws.Cells(Rows.Count, 1).End(xlUp).Row + 1
wsÜ.Range(wsÜ.Cells(gef.Row, 1), wsÜ.Cells(gef.Row, 3)).Copy ws.Cells(efz, 1)
End If
Next i
End Sub

Gruß
Heinz

Anzeige
AW: Bestimmte Daten in gleichnamiges Registerblatt sor
05.02.2013 20:50:49
Marco
Hallo Heinz,
vielen Dank für die schnelle Lösung.
Soweit funktioniert das Makro ganz gut...
Habe es jetzt mit einem Button "Sortieren" verknüpft, nur wenn man zwei,drei, oder mehrere male den Button anklickt, so wird die Liste immer wieder sortiert, und man bekommt nicht mit, ob die Liste schon sortiert wurde.
Eine Lösung wäre eine MessageBox einzubauen, die am Ende des Makro erscheint, dass die Liste sortiert wurde.Nur wie muss ich diese in das Makro integrieren?...ich habe leider keine Ahnung davon...
Gruß
Marco

AW: Bestimmte Daten in gleichnamiges Registerblatt sor
05.02.2013 21:00:03
haw
Hallo Marco,
was meinst du mit sortiert?
Wenn ein Eintrag kein weiteres Mal in die jeweilige Tabelle kopiert werden soll, könnte man z.B. nach dem Übertrag das X durch ein Y ersetzen und es würde kein weiterer Übertrag desselben Bereichs erfolgen.
Oder möglicherweise könnte man die gesamte Zeile nach dem Übertrag löschen.
Wenn du wirklich am Ende eine Messagebox haben willst dann würde das so ausschauen: 
Sub Übertragen()
Dim ws As Worksheet, wsÜ As Worksheet, lz&, i&, efz&, gef As Range
Set wsÜ = ThisWorkbook.Worksheets("Übersicht")
lz = wsÜ.Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To lz
Set gef = wsÜ.Rows(i).Find("X", LookAt:=xlWhole)
If Not gef Is Nothing Then
Set ws = ThisWorkbook.Worksheets(wsÜ.Cells(1, gef.Column).Value)
If ws.Range("A1").Value = "" Then wsÜ.Range("A1:C1").Copy ws.Range("A1")
efz = ws.Cells(Rows.Count, 1).End(xlUp).Row + 1
wsÜ.Range(wsÜ.Cells(gef.Row, 1), wsÜ.Cells(gef.Row, 3)).Copy ws.Cells(efz, 1)
End If
Next i
MsgBox "Liste wurde sortiert!"
End Sub

Gruß
Heinz

Anzeige
AW: Bestimmte Daten in gleichnamiges Registerblatt sor
05.02.2013 21:09:45
Marco
Hallo Heinz,
so schnell hätte ich deine Antwort nicht erwartet...
Mit der MessageBox will ich eigentlich nur erreichen, dass man nicht versehentlich noch einmal den Button klickt, und in den Listen die doppelten Zeilen stehen...oder gibt es noch eine andere Alternative, die keine Duplikate in den Listen zulassen...dann kann man den Button so oft klicken wie man will, und die zeilen werden nur einmal in den Listen aufgeführt?
Gruß
Marco

AW: Bestimmte Daten in gleichnamiges Registerblatt sor
05.02.2013 22:11:47
Marco
Hallo Heinz,
mir ist noch aufgefallen, dass ich in einer Zeile nicht mehrere Spalten mit "X" markieren kann, und in den jeweiligen Listen gefiltert wird...z.B. möchte ich die Zeile 2 in den Listen A und C...hier wird nur in Liste A die Zeile geschrieben.
Da hätte ich gleich noch eine Frage: Ist es möglich die gefilterten Listen A-L per Makro in ein Word-Dokument zu übertragen?...das heisst: Word öffnen, bestimmtes Dokument öffnen ( z.B. mit Namen " Test" ),Liste A aufführen, darunter 2 Leerzeilen, dann Liste B, wieder 2 Leerzeilen, usw?
Gruß
Marco

Anzeige
AW: Bestimmte Daten in gleichnamiges Registerblatt sor
06.02.2013 07:30:41
haw
Hallo Marco,
dass in mehreren Spalten ein X stehen kann, hast du nicht erwähnt.
Das bedingt eine vollkommen andere Herangehensweise.
Den Übertrag in ein Word-Dokument kann man sicher realisieren, nur bin ich in da nicht so firm.
Ich würde das in eine eigene Excel-Tabelle schreiben.
Hier einmal die Lösung für alle X. Das X wird nach erfolgtem Übertrag in X_ umgewandelt. 
Sub Übertragen()
Dim ws As Worksheet, wsÜ As Worksheet, lz&, i&, efz&, gef As Range, Adr$
Set wsÜ = ThisWorkbook.Worksheets("Übersicht")
Set gef = wsÜ.Cells.Find("X", LookAt:=xlWhole)
If Not gef Is Nothing Then
Adr = gef.Address
Set ws = ThisWorkbook.Worksheets(wsÜ.Cells(1, gef.Column).Value)
If ws.Range("A1").Value = "" Then wsÜ.Range("A1:C1").Copy ws.Range("A1")
efz = ws.Cells(Rows.Count, 1).End(xlUp).Row + 1
wsÜ.Range(wsÜ.Cells(gef.Row, 1), wsÜ.Cells(gef.Row, 3)).Copy ws.Cells(efz, 1)
gef.Value = "X_"
End If
Do
Set gef = wsÜ.Cells.FindNext(gef)
If Not gef Is Nothing Then
Set ws = ThisWorkbook.Worksheets(wsÜ.Cells(1, gef.Column).Value)
If ws.Range("A1").Value = "" Then wsÜ.Range("A1:C1").Copy ws.Range("A1")
efz = ws.Cells(Rows.Count, 1).End(xlUp).Row + 1
wsÜ.Range(wsÜ.Cells(gef.Row, 1), wsÜ.Cells(gef.Row, 3)).Copy ws.Cells(efz, 1)
gef.Value = "X_"
End If
Loop While Not gef Is Nothing
End Sub
Gruß
Heinz

Anzeige
AW: Bestimmte Daten in gleichnamiges Registerblatt sor
07.02.2013 22:00:31
Marco
Hallo Heinz,
sorry das ich mich erst heute melde...
Ich muss wirklich sagen, dass es eine geniale Lösung von Dir ist...echt super...
1. Gibt es eine Lösung, die Spalten wieder von "X_" auf "X" zurückzusetzen?...
Ich habe schon was im Internet über Replace gelesen, komme aber nicht weiter, weil es sich immer auf das ganze Arbeitsblatt bezieht, und ich nur auf Spalten wie in meinem Fall "A-L" brauche...
2. Wie kann ich ein bestimmtes Tabellenblatt z.B. A alle Zellen inkl. Formatierung ab Zeile 2 löschen? ( In der ersten Zeile soll nämlich ein Text stehen bleiben )
Diese beiden Bedingungen sollen über ein Makro laufen...
Sorry, wenn ich Dich damit nerve...
Gruß
Marco

Anzeige
AW: Bestimmte Daten in gleichnamiges Registerblatt sor
08.02.2013 06:48:16
haw
Hallo Marco,
der Sinn, X_ wieder auf X zurückzusetzen erschließt sich mir nicht, außer zu Testzwecken, denn ist ja der Sinn, dass einmal übertragene Daten nicht mehr berücksichtigt werden.
Wenn du das willst, dann ganz einfach: Die Spalten B-L markieren und mit Suchen/Ersetzen ersetzen.
Gruß
Heinz

AW: Bestimmte Daten in gleichnamiges Registerblatt sor
12.02.2013 13:46:52
Marco
Hallo Heinz,
nach langem probieren hab ich es endlich bis auf ein paar Kleinigkeiten geschafft.
Du warst mir echt eine große Hilfe für mein Anliegen...und dafür ein herzliches Dankeschön!
Meine weiteren Anliegen werde ich in einen neuen Thread veröffentlichen, da es wohl hier in diesen Beitrag nicht reinpasst.
Ich hoffe weiterhin hier im Forum Hilfe zu finden...ob von Dir, oder andere User...
Bis bald...
Marco
Anzeige

Links zu Excel-Dialogen

MessageBox

Beliebteste Forumthreads (12 Monate)

Anzeige
Jetzt das Excel-Portal bewerten: Deine Stimme zählt!

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige