Quote Originally Posted by georgiboy View Post
Maybe something like:
Sub test()
    Dim unq As Variant, x As Integer, wb As Workbook
    
    unq = Application.Unique(Tabelle1.ListObjects("Tabelle1").ListColumns("Team").DataBodyRange)
    
    For x = 1 To UBound(unq)
        Sheets(Array("Data", "Pivot", "Dashboard")).Copy
        Set wb = ActiveWorkbook
        With ActiveSheet.ListObjects("Tabelle1")
            .Range.AutoFilter Field:=1, Criteria1:="<>" & unq(x, 1), Operator:=xlAnd
            Application.DisplayAlerts = False
                .DataBodyRange.SpecialCells(xlVisible).Delete
            Application.DisplayAlerts = True
            .Range.AutoFilter Field:=1
        End With
        Sheets("Pivot").PivotTables("PivotTable1").ChangePivotCache ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:="Tabelle1", Version:=8)
        Sheets("Pivot").PivotTables("PivotTable2").ChangePivotCache ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:="Tabelle1", Version:=8)
        Sheets("Dashboard").Range("C4") = unq(x, 1)
        wb.SaveAs Filename:=ThisWorkbook.Path & "\" & unq(x, 1) & ".xlsx", FileFormat:=51, Password:=Cells(2, 2)
        wb.Close False
    Next x
End Sub

So far, this has produced the best result. The perfect result actually. However only in excel 2302 (Microsoft Office 365), not in Excel 2016.

But I think I will just stick to Ecxel 2302 then.

I also have one more question:

Would you by any chance know how to edit the Code so that each individually saved file can be send to a specific recipient?

For instance to have an individual text in column F and the respective email adress in column G with a Subject in column H?


Thanks a lot to everyone!