Office: Automatisch Dateien anlegen

Hallo,
ich benötige mal wieder Eure Hilfe. Ich habe eine EXCEL- Datei. Dort steht in Spalte B immer eine Auftragsnummer. Ich möchte nun automatisch alle Zeilen mit der gleichen Auftragsnummer suchen, diese Zeilen jeweils zusammengefasst in eine neue Tabelle eintragen lassen und diese Tabelle dann automatisch abspeichern lassen. Der Name soll einfach die Auftragsnummer sein.
Das sollte sich doch bewerkstelligen lassen. Kann mir jemand helfen?

Danke

Uwe

 

Hallo!

Teste doch mal etwas in dieser Art:

Code:

Sub test()
Dim Blatt As Worksheet, Such$
Set Blatt = ActiveSheet
Such = InputBox("Welche Auftragsnummer?")
With Blatt
If Not .AutoFilterMode = True Then .Range("A1").AutoFilter
.Range("A1").AutoFilter Field:=2, Criteria1:=Such
.Range("A1").CurrentRegion.SpecialCells(xlCellTypeVisible).Copy
.AutoFilterMode = False
End With
Workbooks.Add
Range("A1").PasteSpecial xlPasteAll
ActiveWorkbook.SaveAs Filename:="E:\Test\" & Such, FileFormat:=xlNormal
Application.CutCopyMode = False
End Sub

 

Re

Danke,

das hat schon mal geklappt. Allerdings hat das Makro jetzt nur EINE Zeile kopiert. Wie schaffe ich es, dass alle Zeilen mit diesem Inhalt gesucht und kopiert werden?

Danke

 

Hallo!

Bei mir funktioniert's.
Ich habe die Datei zur Veranschaulichung mal angehängt.

 

Re

Hallo,

also bei mir geht es nicht. Ich habe mal die Datei drangehängt. In Spalte A steht die Auftragsnummer.

Danke

 

Hallo!

Der Autofilter verlangt eindeutige Spalten-Überschriften.
Außerdem sprachst du im ersten Posting von Spalte B, jetzt aber von Spalte A.
Also:
1. Überschriften hinzufügen
2. .Range("A1").AutoFilter Field:=1, Criteria1:=Such

 

Re

Supi,

hat geklappt. Sorry wegen A und B. Habe das Prinzip aber verstanden. Kann ich die Eingabe der Auftragsnummer auch noch automatisieren. Ich habe die Auftragsnummern alle in einer anderen Tabelle. Nennen wir sie mal "Auftragsnummern.xls" und stehen dort tatsächlich ab A1. Ich meine also, das Makro soll sich zuerst die erste dann die zweite usw. Auftragsnummer nehmen und einsetzen.

Nochmals Danke
Uwe

 

Hallo!

Dann vielleicht so:

Code:

Sub test()
Dim Blatt As Worksheet, Such$
Dim Nummer As Range
Const Pfad As String = "E:\Test\"    'hier liegt "Auftragsnummern.xls"
Const x As String = "Auftragsnummern.xls"
Set Blatt = ActiveSheet
Workbooks.Open Pfad & x
For Each Nummer In Workbooks(x).Sheets(1).Columns(1).SpecialCells(xlCellTypeConstants)
Such = Nummer
With Blatt
If Not .AutoFilterMode = True Then .Range("A1").AutoFilter
.Range("A1").AutoFilter Field:=1, Criteria1:=Such
.Range("A1").CurrentRegion.SpecialCells(xlCellTypeVisible).Copy
.AutoFilterMode = False
End With
Workbooks.Add
Range("A1").PasteSpecial xlPasteAll
ActiveWorkbook.SaveAs Filename:="E:\Test\" & Such, FileFormat:=xlNormal
Next Nummer
Application.CutCopyMode = False
End Sub

Öffnet die Datei "Auftragsnummern.xls" und klappert alle Einträge in Spalte A des ersten Tabellenblatts ab.

 

Re

Super :-D ,

vielen Dank. Klappt genauso wie ich es wollte.

DANKE