Daten filtern und neu abspeichern

[StrammerMax]

Hallo zusammen,

folgender Sachverhalt:

Ich habe eine Basisdatei mit den Daten aller Einheiten eines Unternehmens. 
Es gibt über 60 Einheiten. 

Jede Einheit soll eine Datei erhalten mit ihren Daten - aber ausschließlich ihren Daten. 

Ich brauche also ein VBA, welches die Tabelle der Grunddaten filtert und alles was nicht ausgewählt ist löscht. 

Anbei eine Beispieldatei:

  Beispiel 1.xlsx (Größe: 34,48 KB / Downloads: 7)

Auf dem Blatt "Auswertung" wird mit S-Verweisen der Datensatz der Einheit aus dem Blatt "Daten" geholt. 

Es müsste also folgendes passieren: 
1. im Blatt "Daten" eine Einheit Filtern --> z.B. Einheit 2.
2. im Blatt "Daten" alle nicht gefilterten Daten komplett löschen
3. die entstandene Datei unter dem Namen "Einheit2.xls" speichern. 

Und das automatisch mit allen vorher (im VBA Code) definierten Einheiten. 
Man soll also alle ü. 60 Einheiten gleichzeitig erstellen können. 

PS: Es gibt Ausnahmen bei denen mehr als eine Einheit in eine Datei muss. 

Es wäre super nett, wenn mir jemand dabei helfen könnte.

[StrammerMax]

Bzw. verstehe ich folgenden Code nicht richtig

Code:

            'Filtern der Daten in Arbeitsblatt "Data"
            Sheets(strCCworksheet_Data).Select
            ActiveSheet.Range("$A$3:$P$50000").AutoFilter Field:=1, Criteria1:="<>" & k, Operator:=xlFilterValues
            Rows("4:4").Select
            Range(Selection, Selection.End(xlDown)).Select
            Selection.Delete Shift:=xlUp
            ActiveSheet.Range("$A$3:$P$3").AutoFilter Field:=1
           
            'Filtern der Daten in Arbeitsblatt "Systemdaten"
            Sheets(strWorksheet_Systemdaten).Select
            ActiveSheet.Range("$A$11:$I$50000").AutoFilter Field:=9, Criteria1:="<>" & dictCodes(k), Operator:=xlFilterValues
            Rows("12:12").Select
            Range(Selection, Selection.End(xlDown)).Select
            Selection.Delete Shift:=xlUp
            ActiveSheet.Range("$A$11:$I$11").AutoFilter Field:=9

Im Blatt "Data" stehen feste Werte mit einem Autofilter. Dort setzt er den Autofilter auf die entsprechende Einheit und löscht den Rest. --> genau so ist es gewollt. 

Im Blatt "Systemdaten" stehen ebenfalls Werte mit einem Autofilter. Dort löscht er aber die komplette Tabelle, obwohl er eigentlich jeweils eine Einheit beibehalten sollte.

Auf das Blatt Systemdaten verweist der S-Verweis auf dem Blatt Auswertung den ich benötige. Da der vorhandene Code aber alle Daten löscht funktioniert das natürlich nicht.

[StrammerMax]

Code:

'            Filtern der Daten in Arbeitsblatt "Daten"
            Sheets(strWorksheet_Daten).Select
            ActiveSheet.Range("$A$11:$I$50000").AutoFilter Field:=9, Criteria1:="<>" & dictCodes(k), Operator:=xlFilterValues
            Rows("12:12").Select
            Range(Selection, Selection.End(xlDown)).Select
            Selection.Delete Shift:=xlUp
            ActiveSheet.Range("$A$11:$I$11").AutoFilter Field:=9

            'Speichern und schließen der Datei
            Workbooks("NameDerDatei.xlsm").Save
            Workbooks("NameDerDatei.xlsm").Close
            Workbooks(strMasterFileName).Activate

Er gibt mir aber nur die Überschriften aus und darunter ist alles leer --> obwohl es wie im Beitrag darüber dargestellt in einem anderen Blatt genau so funktioniert.

[Fennek]

Hallo,

ich habe kein Interesse Dir einen copy/paste Code zu schreiben,deshalb nur ein paar Ideen:

- eine eindeutige Liste der Abteilungen (aus Spalte B)
- eine Schleife über alle Elemente der Liste

so ähnlich:

Code:

'Liste in Blatt "Liste" ab A1
for i = 1 to sheets("Liste").cells(rows.count, 1).end(xlup).row
with Sheets("Daten").Range("A7").currentregion
     .autofilter 2, sheets("Liste").cells(i,1)
     .copy sheets("Ausgabe").range("A1")
sheets("Ausgabe").copy
     .autofilter
end with
next i

Es bleibt noch einiges zu tun.

mfg