Sub pivot_()

    Dim oWb As Workbook, oWsh As Worksheet, pt As PivotTable, _
        pitm As PivotItem, pitm_ As PivotItem, oRng As Range
        
    Set oWb = ThisWorkbook
    Set oWsh = oWb.Sheets("Сводная")
    Set pt = oWsh.[A1].PivotTable
    Set oRng = ActiveWindow.VisibleRange.Cells(1, 1)
    
    With Application
        .ScreenUpdating = False
        .Calculation = xlCalculationManual
    End With

    For Each pitm In pt.PivotFields!Dpt.VisibleItems
        With oWb.Sheets.Add(, oWb.Sheets(oWb.Sheets.Count))
            .Name = pitm.Caption
            pt.TableRange2.Copy .[A1]
            For Each pitm_ In .PivotTables(1) _
                    .PivotFields!Dpt _
                    .VisibleItems
                pitm_.Visible = pitm_.Caption = .Name
                Application.Goto .[A1], True
            Next
        End With
    Next
    
    Application.Goto oRng, True
    
    With Application
        .ScreenUpdating = True
        .Calculation = xlCalculationAutomatic
    End With
End Sub