Hoe detailpagina's te laten zien via Macro

[Peekhamer]

Ik ben al een tijdje bezig en heb het gevoel dat ik er in de buurt zit, maar kom er toch niet uit.

Ik heb even een versimpelde DT gemaakt (zie bijlage; tabblad HelpmijDT).
Wat ik graag zou willen dat er gebeurt via een macro:

- van iedere Rijlabel (Albert, Henk, Maikel) automatisch een tabblad met de details ("aantal van gefact. Uren")
- tabblad moet de naam van het rijlabel krijgen
- onder het overzicht op iedere tab een totaaltellingregel

Als je de range 'hard' ingeeft dan werkt het: [b4].showdetail = true geeft idd een nieuwe tab met de gegevens. Daarna kun je ook de naam van die tab laten aanpassen naar de rijlabel
Maar via een For each sht ... loop krijg ik het maar niet voor elkaar.

Dim PT As PivotTable, fld As PivotField, pvti As PivotItem
Set PT = ActiveSheet.PivotTables(1)
Set fld = PT.PivotFields("Gefact. Uren")

    For Each fld In PT.PivotFields
            PT.PivotFields.ShowDetail = True
    Next fld

Wat doe ik niet goed?

 

[Peekhamer]

vergeten te vermelden maar het aantal rijlabels is variabel, en de uiteindelijke eindgebruikers snappen niks van macro's dus ik wil hen niet met foutmeldingen opzadelen..

 

[Haije]

Zet kostenplaats in het rapportfilter en kies daarna op het tabblad Hulpmiddelen voor draaitabellen tab Opties voor:
-Opties > Rapportfilterpagina's weergeven....

Er wordt per kostenpost nu een tabblad aangemaakt met als tabblad naam de betreffende kostenpost; zie bijlage

 

[VenA]

Op zich is de code niet zo moeilijk maar welk doel heeft dit? Als je details wil zien kan je toch net zo goed filteren op jouw tabel.

Sub VenA()
With Application
    .ScreenUpdating = False
    .DisplayAlerts = False
    For Each sh In Sheets
        If sh.Name <> "Data" And sh.Name <> "DT" Then sh.Delete
    Next sh
    For Each cl In Sheets("DT").PivotTables("DTmargeTabel").DataBodyRange.Resize(, 1)
        cl.ShowDetail = True
        With ActiveSheet
            .Name = cl.Offset(, -1)
            .Move After:=Sheets(Sheets.Count)
        End With
    Next cl
    .DisplayAlerts = True
    .Goto Sheets("DT").[A1]
End With
End Sub

Als je voorbeeldjes plaatst dan kan je deze beter ontdoen van persoonlijke informatie


* Bijlage aangepast op vraag van TS, persoonlijke informatie eruitgehaald.*

 

[Peekhamer]

Bedankt voor je bericht VenA.

En heel knullig idd maar ik had niet gezien dat er nog data onder de autofilter stond. Zou jij aub je bijlage aan willen passen, dit is idd niet de bedoeling!

Mbt de code heb ik nog een vraagje, kunnen de kolommen f:v automatisch worden voorzien van Autosom en W:W van Gemiddelde?

Heb wat zitten proberen in jouw code als basis maar het lukt niet om alles tegelijk te laten doen:

With ActiveSheet
            .Name = cl.Offset(, -1)
            .Move After:=Sheets(Sheets.Count)
            .ListObjects(1).ShowTotals = True
[COLOR="#FF0000"]            .ListObjects(1).ListColumns("Normale uren").TotalsCalculation = xlTotalsCalculationSum[/COLOR]
            .ListObjects(1).ListColumns("Kpf").TotalsCalculation = xlTotalsCalculationAverage
        End With

Heb array geprobeerd en scheiden met "," of ":" maar hij pakt het niet (geeft ook geen foutmelding)

Het stukje "normale uren" mag in principe worden vervangen door de 'harde verwijzing' F:V (of in kolomheader termen [normale uren] : [uitz behandeld]). Het betreft namelijk een standaard export uit een pakket.

 

[VenA]

Kolom V kan je niet optellen omdat deze tekst bevat.

Als je het via de kolomheaders wil doen kom ik tot dit

Sub VenA()
ar = Array("Normale uren", "Over/reis uren", "Ploeg/versch uren", "Gewerkte uren", "Overige uren", "Gefact. uren", _
    "Vergoeding belast", "Vergoeding onbelast", "Bruto loon berek.", "Kosten Inleentarief", "Loonkosten totaal", _
    "Gefactureerd uren", "Gefactureerd overig", "Gefactureerd totaal", "Winst totaal", "Winst per uur")

With Application
    .ScreenUpdating = False
    .DisplayAlerts = False
    For Each sh In Sheets
        If sh.Name <> "Data" And sh.Name <> "DT" Then sh.Delete
    Next sh
    For Each cl In Sheets("DT").PivotTables("DTmargeTabel").DataBodyRange.Resize(, 1)
        cl.ShowDetail = True
        With ActiveSheet
            .Name = cl.Offset(, -1)
            .Move After:=Sheets(Sheets.Count)
            With .ListObjects(1)
                .ShowTotals = True
                For j = 0 To UBound(ar)
                    .ListColumns(ar(j)).TotalsCalculation = xlTotalsCalculationSum
                Next j
                .ListColumns("Kpf").TotalsCalculation = xlTotalsCalculationAverage
            End With
        End With
    Next cl
    .DisplayAlerts = True
    .Goto Sheets("DT").[A1]
End With
End Sub

Knalt er soms uit. Maar kan nog niet vinden waarom.

 

[Peekhamer]

thanx voor de aanvulling. Je hebt gelijk, Kolom V wordt kolom U.

Ik zat te denken, is het heel dom om de laatste regel op te zoeken per sheet, en daarmee een subtotal formule in te voegen voer F6:U6? Dit kan binnen dezelfde With ... end With. Dan hoef je niet met Array aan de gang etc.?

 

[VenA]

Dat kan je toch prima even zelf proberen?

 

[Peekhamer]

ben ondertussen ook bezig idd :thumb:

 

[Peekhamer]

heb m maar per stuk gefixt. Niet de fraaiste oplossing maar het werkt gewoon goed. En de code is toch klein.

Bedankt voor de hulp!

 

[VenA]

Wil je nog wel even laten zien hoe je het gefixt hebt?