Office: s:Makro für Pivottabelle

Hallo zusammen,

ich habe folgendes Problem.
Ich habe eine Pivottabelle. In dieser habe ich in den Zeilenfelder die Möglichkeit eien mehrfachauswahl zu treffen. Ich möchte nun diese Mehrfachauswahl auch für andere Pivottabellen im selben,sowie in anderen sheets per Makro übertragen. Ist das überhaupt möglich? Wenn ja wie könnte das Makro aussehen.

Kurze info

Die Pivottabelle mit der einstellung ist im Sheet "Start" und heißt PivotTable4 und das Auswahlfeld heißt "Problemdatum" .
Ich möchte diese Einstellung nun für die Pivottabelle im sheet "Overview" in PivotTable6 übernehmen...das Auswahlfeld hat den selben Namen "Problemdatum"

ich versuche schon ewig rum und googln hat nicht viel gebracht bis jetzt einen makro für die seitenfelder habe ich hinbekommen..das war relativ einfach....aber bei der Mehrfachauswahl fehlt mir das wissen...bin noch blutiger Anfänger ;o)

Für einen Vorschlag,wie das Makro aussehen könnte wär ich wahnsinnig dankbar.....Ich danke euch schonmal. LG dbrauni


Ich hoffe ihr könnt mir helfen. :roll: :-D :mrgreen:

 

Hat sich erledigt ;)

Problem gelöst bekommen.
ub PivotTabSynchronisieren()
Dim pvTabMaster As PivotTable, pvTabSlave As PivotTable
On Error GoTo Fehler

'Master-Pivot setzen
Set pvTabMaster = Worksheets("Start").PivotTables("PivotTable4")

'Slave-Pivot Nr. 1 setzen
Set pvTabSlave = Worksheets("Start").PivotTables("PivotTable1")
'Subroutine zum Abgleich der Items aufrufen
Call PivotSynchronisieren(pvFieldMaster:=pvTabMaster.PivotFields("Problemdatum"), _
pvFieldSlave:=pvTabSlave.PivotFields("Problemdatum"))

'Slave-Pivot Nr. 2 setzen
Set pvTabSlave = Worksheets("Start").PivotTables("PivotTable2")
'Subroutine zum Abgleich der Items aufrufen
Call PivotSynchronisieren(pvFieldMaster:=pvTabMaster.PivotFields("Problemdatum"), _
pvFieldSlave:=pvTabSlave.PivotFields("Problemdatum"))

'Slave-Pivot Nr. 3 setzen
Set pvTabSlave = Worksheets("Start").PivotTables("PivotTable3")
'Subroutine zum Abgleich der Items aufrufen
Call PivotSynchronisieren(pvFieldMaster:=pvTabMaster.PivotFields("Problemdatum"), _
pvFieldSlave:=pvTabSlave.PivotFields("Problemdatum"))

'Slave-Pivot Nr. 4 setzen
Set pvTabSlave = Worksheets("Start").PivotTables("PivotTable9")
'Subroutine zum Abgleich der Items aufrufen
Call PivotSynchronisieren(pvFieldMaster:=pvTabMaster.PivotFields("Problemdatum"), _
pvFieldSlave:=pvTabSlave.PivotFields("Problemdatum"))

'Slave-Pivot Nr. 5 setzen
Set pvTabSlave = Worksheets("Start").PivotTables("PivotTable10")
'Subroutine zum Abgleich der Items aufrufen
Call PivotSynchronisieren(pvFieldMaster:=pvTabMaster.PivotFields("Problemdatum"), _
pvFieldSlave:=pvTabSlave.PivotFields("Problemdatum"))

'Slave-Pivot Nr. 6 setzen
Set pvTabSlave = Worksheets("Start").PivotTables("PivotTable11")
'Subroutine zum Abgleich der Items aufrufen
Call PivotSynchronisieren(pvFieldMaster:=pvTabMaster.PivotFields("Problemdatum"), _
pvFieldSlave:=pvTabSlave.PivotFields("Problemdatum"))

'Slave-Pivot Nr. 7 setzen
Set pvTabSlave = Worksheets("Start").PivotTables("PivotTable12")
'Subroutine zum Abgleich der Items aufrufen
Call PivotSynchronisieren(pvFieldMaster:=pvTabMaster.PivotFields("Problemdatum"), _
pvFieldSlave:=pvTabSlave.PivotFields("Problemdatum"))
Fehler:
With Err
If .Number <> 0 Then
MsgBox "Fehler-Nr. " & .Number & vbLf & .Description
End If
End With
End Sub

Sub PivotSynchronisieren(pvFieldMaster As PivotField, pvFieldSlave As PivotField)
Dim pvItemMaster As PivotItem, pvItemSlave As PivotItem
Dim bolHide As Boolean, intFehler As Integer
'Synchronisiert die gewählten Item zwischen zwei Pivottabellen
On Error GoTo Fehler
'Alle Items des Slave Objekts anzeigen
For Each pvItemSlave In pvFieldSlave.PivotItems
intFehler = 1
If pvItemSlave.Visible = False Then pvItemSlave.Visible = True
Next
'Nicht anzuzeigende Items ausblenden
For Each pvItemSlave In pvFieldSlave.PivotItems
bolHide = True
For Each pvItemMaster In pvFieldMaster.VisibleItems
intFehler = 2
If pvItemMaster.Name = pvItemSlave.Name Then bolHide = False: Exit For
Next
If bolHide = True Then
pvItemSlave.Visible = False
End If
Next
Fehler:
With Err
If .Number <> 0 Then
If .Number = 1004 Then 'fängt nicht mehr existierendes Pivotelement _
ab dass angezeigt werden soll
If intFehler = 1 Then
pvItemSlave.Delete
intFehler = 0
Resume Next
ElseIf intFehler = 2 Then
MsgBox "In der Slave-Pivottable """ & pvFieldSlave.Parent.Name _
& """ können keine weiteren Items ausgeblendet werden!"
End If
Else
MsgBox "Fehler-Nr. " & .Number & vbLf & .Description
End If
End If
End With
End Sub