Beste ik heb de volgende vraag:
Ik wil een macro in excel , die alle draaitabellen in het bestand controleert op regels met een voorwaardelijke opmaak. Vervolgens moeten deze regels onder elkaar gekopieerd worden op het tabblad genaamd check. Het liefst met de kolomlabels van de desbtreffende draaitabel waar de regel met voorwaardelijk opmaak is gevonden.
Nu heb ik op een forum de onderstaande macro gevonden, deze lijkt echter niks te doen. Ik heb een bestand toegevoegd (zonder de macro) deze hieronder
Al vast erg bedankt
Ik wil een macro in excel , die alle draaitabellen in het bestand controleert op regels met een voorwaardelijke opmaak. Vervolgens moeten deze regels onder elkaar gekopieerd worden op het tabblad genaamd check. Het liefst met de kolomlabels van de desbtreffende draaitabel waar de regel met voorwaardelijk opmaak is gevonden.
Nu heb ik op een forum de onderstaande macro gevonden, deze lijkt echter niks te doen. Ik heb een bestand toegevoegd (zonder de macro) deze hieronder
Code:
Sub CheckDraaitabellen()
Dim pt As PivotTable
Dim pf As PivotField
Dim pi As PivotItem
Dim cf As FormatCondition
Dim i As Long
Dim j As Long
'Wis de gegevens in het "check"-tabblad
Sheets("check").Cells.ClearContents
'Loop door alle draaitabellen in het huidige werkblad
For Each pt In ActiveSheet.PivotTables
'Loop door alle velden in de draaitabel
For Each pf In pt.PivotFields
'Loop door alle items in het veld
For Each pi In pf.PivotItems
'Loop door alle voorwaardelijke opmaakregels van het item
For i = 1 To pi.FormatConditions.Count
Set cf = pi.FormatConditions(i)
'Als de opmaakregel voldoet aan de voorwaarde, kopieer de regel naar het "check"-tabblad
If cf.AppliesTo(pi) And Not cf.StopIfTrue Then
j = Sheets("check").Cells(Rows.Count, 1).End(xlUp).Row + 1
pi.Range.Copy Sheets("check").Cells(j, 1)
End If
Next i
Next pi
Next pf
Next pt
End SubAl vast erg bedankt
