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

Hello,

Thank you so much, that works!

Just another question now:

I tried it again on another Comnputer with a different excel Version (Microsoft Excel Professional Plus 2016 (16.0.5378.1000)

Now there is a runtime error (438).

And ideas what the problem could be?


Best regards,

Mojo-G