The code you provided only copies the filtered data from the "Data" worksheet. To include the "Pivot" and "Dashboard" worksheets as well, you can modify the code as follows:
Code:
Sub split()
Dim MyDic As Object, rng As Range, Zelle As Range, ws As Worksheet, wb As Workbook
Application.ScreenUpdating = False
Set MyDic = CreateObject("Scripting.Dictionary")
Set ws = ThisWorkbook.Worksheets("Data")
With ws
Set rng = .Range(.Cells(1, 1), .Cells(.Rows.Count, 1).End(xlUp))
For Each Zelle In rng.Offset(1, 0)
If MyDic(Zelle.Value) = "" And Not IsEmpty(Zelle) Then
MyDic(Zelle.Value) = 1
rng.AutoFilter field:=1, Criteria1:=Zelle
Set wb = Workbooks.Add
' Copy "Data" worksheet
.UsedRange.SpecialCells(xlCellTypeVisible).Copy wb.Sheets(1).Cells(1, 1)
wb.Sheets(1).Name = "Data"
' Copy "Pivot" and "Dashboard" worksheets
ThisWorkbook.Worksheets("Pivot").Copy After:=wb.Sheets(wb.Sheets.Count)
ThisWorkbook.Worksheets("Dashboard").Copy After:=wb.Sheets(wb.Sheets.Count)
' Save the new workbook
wb.SaveAs Filename:=ThisWorkbook.Path & "\" & Zelle & ".xlsx", FileFormat:=51, Password:=Zelle.Offset(0, 1).Value
wb.Close False
rng.AutoFilter
End If
Next
End With
Application.ScreenUpdating = True
End Sub
This code will create new workbooks with all three worksheets (Data, Pivot, and Dashboard) for each team, and the data in the new workbooks will only show the respective team's data. The newly created workbooks will be encrypted with the passwords in column B.