Makro: Tabelle immer wieder filtern, in eine neue Datei kopieren, neu filtern,...

Question

Hey.

Ich habe folgendes Problem:
Ich habe eine Tabelle, in der eine Spalte (zB: Spalte O) 20 verschieden Werte enthält (zB: Deutschland, Italien, Frankreich,...)
Die Spalte O soll automatisch nach allen Werten nacheinander gefiltert werden und jedes mal nachdem es gefiltert wurde, soll die Tabelle mit den gefilterten Werten in eine neue Datei kopiert werden. Diese soll dann wie das Land, nachdem die Tabelle gefiltert wurde, benannt werden.

Als Beispiel:
Erster Durchlauf: Tabelle wird nach Italien gefiltert, gefilterte Daten werden kopiert und in eine neue Datei "Italien" eingefügt. Danach wird der Filter wieder gelöscht und nach Frankreich gefiltert. Same here. Dies soll solange geschehen bis alle Werte in der Spalte gefiltert und in eine neue Datei kopiert wurden.

Kann mir hierbei jemand helfen :)?

Wäre super :)

Answer 1

hi all ^^

wie gewünscht !

Gruss Nighty

Sub NeueMappen()
Dim Zelle As Range
Columns("O:O").Sort Key1:=Range("O2"), Order1:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
For Each Zelle In Worksheets(1).Range("O2:O" & Worksheets(1).UsedRange.SpecialCells(xlCellTypeLastCell).Row)
If LandName <> Zelle And Zelle <> "" Then
LandName = Zelle
Workbooks.Add
ChDir ThisWorkbook.Path
Workbooks(1).Worksheets(1).Range("O1").AutoFilter Field:=1, Criteria1:=Zelle
Workbooks(1).Worksheets(1).Rows("1:" & Workbooks(1).Worksheets(1).UsedRange.SpecialCells(xlCellTypeLastCell).Row).Copy ActiveWorkbook.Worksheets(1).Range("A1")
Workbooks(1).Worksheets(1).Range("O1").AutoFilter
ActiveWorkbook.SaveAs Filename:=Zelle, CreateBackup:=False
ActiveWorkbook.Close
End If
Next Zelle
End Sub

Answer 2

Vielen, vielen Dank!

Das Makro funktioniert, Excel erstellt für jedes Land eine neue Datei, jedoch wird lediglich die erste Zeile kopiert, jedoch nicht die Tablle (geht von A1 bis O43000)
Auch wird die Urpsrungsdatei leicht verändert. Nach dem Ausführen des Makros wird die Überschrift der Spalte Länder umbenannt in Deutschland. Die Urpsrungsdatei sollte jedoch gleich bleiben.

Könntest du mir noch einmal helfen :) ?

Wäre wirklich ultra klasse :)

Answer 3

hi :-)

Dann schick mir doch eine Dummydatei(Beispieldatei) !
Aber bitte im xls Format,ich nutze noch Excel 2000 :-)
und entsprechende detaillierte Wunschliste !

Deine Fehlerbeschreibung ist ja amüsant :-))

Email
Oberley@t-online.de

Gruss Nighty

Answer 4

hi :-)

Die Sortierung wäre aber von Vorteil bei der Quelldatei
Ohne Sortierung wäre es natürlich auch kein Problem
Doch würde es das Makro bestimmt vom Umfang verdoppeln und die Laufzeit verlangsamen

Alles andere klärt sich mit einer Beispieldatei im xls Format

Gruss Nighty

Answer 5

hi ^^

falsche überschrift ist ein fehler der Sortierung gewesen

ersetze diese zeile
Columns("O:O").Sort Key1:=Range("O2"), Order1:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
durch
Range("O2:O" & ActiveSheet.Cells(Rows.Count, 15).End(xlUp).Row).Sort Key1:=Range("O2"), Order1:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom

schick trotzdem eine Datei wenn du möchtest

gruss nighty

Answer 6

hi ^^

Vielleicht sollen die gefilterten Daten nur bezug zum neuen Mappennamen haben ?
und danach OHNE Filterung alle Daten in die neue Mappe ?

Da bleiben ja nur die 2 Optionen mit oder ohne Filterung kopieren ?

Gruss Nighty

Answer 7

hi :-)

probier dich mal ^^

Gruss Nighty

Sub MitFilter()
Dim Zelle As Range
Dim Landname As String
Range("O2:O" & ActiveSheet.Cells(Rows.Count, 15).End(xlUp).Row).Sort Key1:=Range("O2"), Order1:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
ChDir ThisWorkbook.Path
For Each Zelle In Worksheets(1).Range("O2:O" & Worksheets(1).UsedRange.SpecialCells(xlCellTypeLastCell).Row)
If Landname <> Zelle And Zelle <> "" Then
Landname = Zelle
Workbooks.Add
Workbooks(1).Worksheets(1).Range("O1").AutoFilter Field:=1, Criteria1:=Zelle
Workbooks(1).Worksheets(1).Rows("1:" & Workbooks(1).Worksheets(1).UsedRange.SpecialCells(xlCellTypeLastCell).Row).Copy ActiveWorkbook.Worksheets(1).Range("A1")
Workbooks(1).Worksheets(1).Range("O1").AutoFilter
ActiveWorkbook.SaveAs Filename:=Zelle, CreateBackup:=False
ActiveWorkbook.Close
End If
Next Zelle
End Sub

Sub OhneFilter()
Dim Zelle As Range
Dim Landname As String
Range("O2:O" & ActiveSheet.Cells(Rows.Count, 15).End(xlUp).Row).Sort Key1:=Range("O2"), Order1:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
ChDir ThisWorkbook.Path
For Each Zelle In Worksheets(1).Range("O2:O" & Worksheets(1).UsedRange.SpecialCells(xlCellTypeLastCell).Row)
If Landname <> Zelle And Zelle <> "" Then
Landname = Zelle
Workbooks.Add
Workbooks(1).Worksheets(1).Rows("1:" & Workbooks(1).Worksheets(1).UsedRange.SpecialCells(xlCellTypeLastCell).Row).Copy ActiveWorkbook.Worksheets(1).Range("A1")
ActiveWorkbook.SaveAs Filename:=Zelle, CreateBackup:=False
ActiveWorkbook.Close
End If
Next Zelle
End Sub

[/code]

Answer 8

hey :)

Danke für die schnelle Antwort :)
Leider habe ich gerade keinen Zugriff auf mein E-mail Konto, ich werde es mal so versuchen zu erklären, falls es nicht klappt schicke ich dir Abends eine Dummydatei :)

Das Makro erstellt bei mir alle Dateien, welche nach dem jeweilig gefilterten Land benannt werden. Auch die Spaltenüberschriften aus meiner Datei werden durch das Makro in die einzelnen Dateien kopiert. In den Spalten befinden sich allerdings Daten, diese werden jedoch nicht rüber kopiert. Es sollen aber die Daten die gefiltert wurden (nicht die ganze Tabelle, sondern nur die Daten die zu dem gefilterten Land gehören) kopiert werden.

Als Beispiel:
Name Alter Land

Huber 41 Deutschland
Müller 20 Russland
Maier 35 Frankreich
Mustermann 18 Frankreich
Biene 20 Deutschland
Stachel 14 Deutschland

Nun soll zB nach Frankreich sortiert werden, anschließend soll eine Datei erstellt werden die mit dem Dateinamen Frankreich abgelegt wird und die Datei soll folgende Tabelle enthalten:

Name Alter Land

Maier 35 Frankreich
Mustermann 18 Frankreich


Ich hoffe du weißt nun was ich brauche :D
Das einzigste was das Makro noch nicht macht, ist, den Inhalt der Tabelle zu kopieren, also folgendes:
Maier 35 Frankreich
Mustermann 18 Frankreich

Der Rest funktioniert bereits :)

War das verständlich oder soll ich doch lieber eine Datei schicken :D ?

Lg

Answer 9

hi :-)

Was du beschreibst sollte das erste Makro eigentlich machen :-)
Irgendwo hakelt es wohl .-)

Schick lieber eine DummDatei :-)

Gruss Nighty