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