Страницы: 1
RSS
Разделение сводной по листам, Есть сводная таблица. Нужно разделить её на листы по фильтру
 
Есть сводная. Первая категория - завод. На каждый завод нужен отдельный лист со сводной только для этого завода. Мой файл гораздо больше, конечно, но примерно как в прикреплённом файле.
 
Excelopfer, ну так копируйте и фильтруйте или поле заводы в фильтры перетащите и выберите нужный Вам завод и так на каждом листе или в чем вопрос? в файле не нашел желаемого результата просто
Изменено: Mershik - 08.04.2021 14:09:03
Не бойтесь совершенства. Вам его не достичь.
 
Много заводов в оригинальном файле. Не хочется копировать. Нужно, чтобы автоматически скопировалось и по листу на завод
 
Excelopfer, может так попробовать
Код
Sub mrshkei()
Dim col As New Collection, arr, i As Long, sh As Worksheet, sh2 As Worksheet
Application.ScreenUpdating = False
Set sh = Worksheets("Database")
arr = sh.Range(sh.Cells(2, 2), sh.Cells(sh.Cells(Rows.Count, 2).End(xlUp).Row, 2))
For i = LBound(arr) To UBound(arr)
    On Error Resume Next
    If arr(i, 1) <> epmty Then col.Add arr(i, 1), CStr(arr(i, 1))
Next i
For i = 1 To col.Count
    Worksheets("Сводная").Copy Before:=Sheets(2)
    ActiveSheet.Name = col(i)
'------------------------------------------------------------------------------------------------
    With ActiveSheet.PivotTables("PivotTable1").PivotFields("Завод")
        .Orientation = xlPageField
        .Position = 1
    End With
    ActiveSheet.PivotTables("PivotTable1").PivotFields("Завод").CurrentPage = _
        "(All)"
    With ActiveSheet.PivotTables("PivotTable1").PivotFields("Завод")
        .PivotItems("").Visible = False
    For n = 1 To col.Count
    x = col(n)
        If col(i) <> col(n) Then .PivotItems(x).Visible = False
    Next n
    End With
'------------------------------------------------------------------------------------------------
Next i
Application.ScreenUpdating = True
End Sub
Не бойтесь совершенства. Вам его не достичь.
Страницы: 1
Наверх