Auszug aus Masterdatei in separate Datei

[Theo]

Guten Tag Helfer

Ich habe folgende Aufgabe zu lösen:

Es besteht eine Masterdatei mit über 100 Einträgen für 8 Departemente, die laufend ergänzt wird.

Jeder Departementsleiter soll eine verlinkte Datei erhalten, in der nur die ihn betreffenden Einträge zu sehen sind.
Es müssen wirklich nur die ihn betreffenden Einträge darin stehen, also kein Filter, auch wenn er noch so geschützt ist.
Schlüssel ist das Departement.
Als Anhang eine Beispieldatei.

Geht das mit einer Funktion oder muss ein Makro geschrieben werden?

Für Eure Vorschläge bin ich dankbar.

Gruss 

Theo

[WillWissen]

Hi Theo,

ich habe im Anhang einen ZIP-Ordner mit der Masterdatei und jeweils einer Datei für die Departements 1-3. Schau mal, ob es das ist, was du dir vorstellst. Die einzelnen Dapartements-Dateien müssen nach dem Öffnen aktualisiert werden.


  Departements.zip (Größe: 47,65 KB / Downloads: 7)

[schauan]

Hallo Theo,

der Teil mit der separaten Datei geht nur mit Makro, oder Du machst es von Hand. Das Makro würde genau so funktionieren.
- ein Department filtern
- gefilterte Daten auf ein neues Blatt kopieren
- Blatt in neue Mappe verschieben
- neue Mappe unter gewünschtem Namen speichern
- weiter mit näcstem Department

Dann kannst Du den Chefs einen Link auf die Mappen schicken oder die Mappen direkt - ich weiß nicht, was "eine verlinkte Datei schicken" bewirken soll. Im Moment fällt mir dazu leider nur ein, entweder ich schicke jemanden eine Datei oder den Link darauf.

Ich habe nun mal den code für ein Department aufgezeichnet. Man könnte das für alle aufzeichnen, würde auch gehen und wäre entsprechend lang..

Code:

Sub Makro1()
'
' Makro1 Makro
'

'
    Range("A1").Select
    Selection.AutoFilter
    ActiveSheet.Range("$A$1:$C$10").AutoFilter Field:=1, Criteria1:= _
        "Departement 1"
    Range("A1:C10").Select
    Selection.Copy
    Sheets.Add After:=ActiveSheet
    ActiveSheet.Paste
    Sheets("Tabelle4").Select
    Application.CutCopyMode = False
    Sheets("Tabelle4").Move
    ChDir "D:\"
    ActiveWorkbook.SaveAs Filename:="D:\Department 1.xlsx", FileFormat:= _
        xlOpenXMLWorkbook, CreateBackup:=False
    Cells.Select
    Cells.EntireColumn.AutoFit
    Range("A1").Select
    ActiveWorkbook.Save
    ActiveWindow.Close
    Sheets("Tabelle1").Select
    Selection.AutoFilter
End Sub

So, hier der weiterentwickelte code. Ich habe mit einer Schleife die 3 Departments abgearbeitet. Den ersten code brauchst Du nicht zu nehmen, der ist nur, dass Du die "Basis" für den zweiten siehst und mal schauen kannst, was ich da so alles geändert habe. Zur Erläuterung habe ich reichlich Kommentare eingefügt.

Für den code wechselst Du mit ALT+F11 in den VBA-Editor. Über das Menü Einfügen fügst Du ein Modul ein und kopierst den code dort hinein.

Code:

Sub Makro2()
'Hinweis: ohne Feherbehandlung!
'Variablendeklarationen
'Integer
Dim iCnt%
'Schleife ueber Departments 1 bis 3
For iCnt = 1 To 3
    'Autofilter setzen
    Range("A1").AutoFilter
    'Bereich A1:C1000 nach Department filtern,
    'Hnweis: statt 1000 eine ausreichend große Zeilennummer nehmen
    ActiveSheet.Range("$A$1:$C$1000").AutoFilter Field:=1, Criteria1:= _
        "Departement " & iCnt
    'Gefilterten Bereich kopieren
    Range("A1:C1000").Copy
    'Neues Blatt hinzufuegen
    Sheets.Add After:=ActiveSheet
    'Gefilterte Daten einfuegen
    ActiveSheet.Paste
    'Kopiermodus aus
    Application.CutCopyMode = False
    'Aktives Blatt als neue Datei verschieben
    ActiveSheet.Move
    'Laufwerk wechseln, muss eventuell nicht sein
    ChDir "D:\"
    'Neue Datei speichern unter Department...xlsx
    'Hinweis: Bei Bedarf Laufwerk und Verzeichnis aendern
    ActiveWorkbook.SaveAs Filename:="D:\Department " & iCnt & ".xlsx", FileFormat:= _
        xlOpenXMLWorkbook, CreateBackup:=False
    'Zellen auswaehlen
    Cells.Select
    'Spaltenbreite automatisch setzen
    Cells.EntireColumn.AutoFit
    'A1 auswaehlen
    Range("A1").Select
    'Datei Speichern
    ActiveWorkbook.Save
    'Datei schliessen
    ActiveWindow.Close
    'Tabelle 1 wieder auswaehlen
    'Hinweis: wenn die Quelldatei nur ein Blatt hat, kann das entfallen
    Sheets("Tabelle1").Select
    'Autofilter ausschalten
    'Hinweis: reicht auch nach der Schleife
    Selection.AutoFilter
'Ende Schleife ueber Departments 1 bis 3
Next
End Sub

[Theo]

Ich habe nun mal den code für ein Department aufgezeichnet. Man könnte das für alle aufzeichnen, würde auch gehen und wäre entsprechend lang..  

Hallo André

Ich hoffe es geht Dir gut.
Herzlichen Dank für Dein VBA. Ist wie immer perfekt.

Die Verantwortlichen wünschen jederzeit den aktuellen Status zu sehen.
Sie wollen in Ihrem eigenen Departements-Ordner eine Datei, die verlinkt ist mit der Datei im Personalbüro.
Mit einem Klick auf "aktualisieren" haben sie dann die entsprechenden Infos.


Ich werde morgen mit der Version von Günter die Original-Datei testen. Mit den wenigen Testdaten funktioniert diese Möglichkeit bereits.

Ich wünsche Dir noch einen schönen Rest-Sonntag und nochmals ganz herzlichen Dank.

Gruss

Theo

Theo

[Theo]

Hi Theo,

ich habe im Anhang einen ZIP-Ordner mit der Masterdatei und jeweils einer Datei für die Departements 1-3. Schau mal, ob es das ist, was du dir vorstellst. Die einzelnen Dapartements-Dateien müssen nach dem Öffnen aktualisiert werden.

Hallo Günter

herzlichen Dank für Deine Unterstützung.
Du hast am 25.5.2015 zum Thema:"Sverweis, mehrere Treffer anzeigen lassen" ebenfalls einen Betrag geschrieben.

Ich habe jetzt, so glaube ich wenigstens, eine Lösung ohne Hilfsspalte gefunden.
Eben mit Deinem Beitrag vom 25.5. kombiniert.
Ich habe Deine Formel in eine Matrix-Funktion gesteckt.
Mit den Testdaten funktioniert dies.

Anfangs nächste Woche werde ich die Live-Datei testen.
Ich gebe Dir auf jeden fall Bescheid.

Nochmals besten Dank.

Gruss

Theo

[WillWissen]

Hi Theo,

Ich habe Deine Formel in eine Matrix-Funktion gesteckt.

Mit den Testdaten funktioniert dies.

mit den wenigen Datensätze, die du anscheinend hast (Zitat: "Es besteht eine Masterdatei mit über 100 Einträgen für 8 Departemente, die laufend ergänzt wird."), dürfte eine Matrixlösung kein Problem darstellen. Bei sehr umfangreichen Daten kann u.U. dein Xl etwas in die Knie gehen.