VBA Tabellenblätter separat speichern

Hallo zusammen,
ich habe ein Dashboard erstellt, das per Datenschnitt erlaubt verschiedene Merkmale zu Filtern. Bspw. bestimmte Produkte, Varianten sowie Mitarbeiter.
Im Hintergrund beziehen sich die Filter und Kennzahlen auf ein Blatt mit mehreren Pivot-Tabellen, das geschützt und ausgeblendet ist.
Das Dasboard selbst ist auch geschützt, um zu verhindern, dass bestimmte Datenschnitte oder Grafiken verändert werden - einzelne Datenschnitte sind jedoch vom Schutz aufgehoben.
Es hat sich auf der Wegstrecke herausgestellt, dass die Mitarbeiter die KPIs der anderen Kollegen nicht sehen dürfen und nun jeder ein eigenes Dashboard erhalten soll.
Da es sich um rund 100 Personen handelt, benötige ein Makro, das für jeden Mitarbeiter ein eigenes Dashboard ausleitet. Ist es möglich dies über den Datenschnitt zu steuern und zusätzlich das im Hintergrund befindliche Blatt mit den Pivots jedem Extrakt versteckt und geschützt zuzufügen?
Oder sollte die Dashboard-Ansicht für jede Person kopiert und vorgefiltert werden, um sie gemeinsam mit dem Pivot-Blatt ausleiten zu können?
Anbei eine Beispiel-Datei. (Datenschnitte unter "Dashboard" auf der linken Seite)
https://www.herber.de/bbs/user/156466.xlsx
Vielen Dank vorab für die Hilfe!

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub Kopie_pro_MA_speichern() Dim MA_Liste As Object Dim LO As ListObject Dim R, Rc Dim Dateiname As String Dim Wb As Workbook Set MA_Liste = CreateObject("Scripting.Dictionary") Set LO = Worksheets("Data(versteckt+geschützt)").ListObjects(1) For Each R In LO.DataBodyRange.ListRows MA_Liste(R.Cells(LO.ListColumns("Name 1").Index).Value) = 1 Next For Each R In MA_Liste.Keys Dateiname = Replace(ThisWorkbook.FullName, ".xlsx", R & ".xlsx") ThisWorkbook.SaveCopyAs Dateiname Set Wb = Workbooks.Open(Dateiname) Set LO = Wb.Worksheets("Data(versteckt+geschützt)").ListObjects(1) For Rc = LO.ListRows.Count To 1 Step -1 If LO.ListRows(Rc).Range.Cells(LO.ListColumns("Name 1").Index).Value R Then LO.ListRows(Rc).Delete Next Wb.Save Wb.Close Next Set MA_Liste = Nothing End Sub

Sub nameloeschen() Dim i As Long Application.ScreenUpdating = False For i = Cells(Rows.Count, 1).End(xlUp).Row To 1 Step -1 If Cells(i, 7) = "Max Mustermann" Then Rows(i).Delete If Cells(i, 7) = "Michael Mustermann" Then Rows(i).Delete Next i Application.ScreenUpdating = True End Sub

Beliebteste Forumthreads (12 Monate)

VBA Tabellenblätter separat speichern

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

304 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

VBA Tabellenblätter separat speichern

6 Beiträge zum Forumthread Beiträge zu diesem Forumthread

304 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread