Angeklickte Datenschnittauswahl in Zelle schreiben

[Sandra]

Hallo miteinander,

evtl kann mir ja jemand von Euch helfen? Ich habe eine Pivottabelle mit mehreren Datenschnitten. Die Möglichkeit alle angeklickten Datenschnitte (deren Optionen) in eine Zelle zu schreiben, habe ich schon herausgefunden mit folgendem Code:
Sub Bereich_Klicken()
Dim sUeberschrift As String
For Each x In ActiveWorkbook.SlicerCaches
For Each y In x.SlicerItems
If y.Selected = True Then
sUeberschrift = y.Name
Exit For
End If
Next
Next
Range("A1") = sUeberschrift
End Sub
-> landet dann als Text alles in einer Zelle

Wie bekomme ich es aber hin, dass nur jede angeklickte(n) Option(en) in eine separate Zelle (und bei mehreren Optionen - diese entsprechend untereinander) geschrieben wird?
Also Beispiel: 
Datenschnitt 1 -> Option B -> angeklickt -> schreibe in Zelle A1 "B"
Datenschnitt 2 -> Option A -> angeklickt -> schreibe in Zelle B1 "A"
Datenschnitt 3 -> nichts  angeklickt -> schreibe in Zelle C1 " "
Datenschnitt 4 -> Option C, D -> angeklickt -> schreibe in Zelle D1"C" und in Zelle D2 "D".
usw.?

Ich weiß, man kann natürlichen sehen was man angeklickt hat, aber ich benötige explizit die angeklickten Begriffe jeweils in einer extra Zelle?

Vielen Dank vorab!

[Ralf A]

Moin,

da braucht es kein VBA. Nehmen wir an, die vom Slicer zu filternden Daten befinden sich im Bereich  A6:A18 der Pivottabelle. Und in F1 soll angezeigt werden, was ausgewählt wurde, dann gibst Du in F2 folgende Formel ein: 
=TEXTKETTE(A6:A18;", ")

Die zeigt Dir kommasepariert die ausgewählten Werte an.

Du kannst dem Bereich im Namensmanager auch einen Namen vergeben und Dich in der Formel dann auf den Namen beziehen.

[Andreas Killer]

Code:

Option Explicit
Option Compare Text

Sub Bereich_Klicken()
  Dim SC As SlicerCache
  Dim SI As SlicerItem
  Dim Dest As Range
 
  For Each SC In ActiveWorkbook.SlicerCaches
    'Je nach Slicer Zielzelle festlegen
    Select Case SC.Name
      Case "Datenschnitt_Nr"
        Set Dest = Range("A1")
      Case "Datenschnitt_Name"
        Set Dest = Range("B1")
      Case Else
        MsgBox "Unbekannter Datenschnitt, Abbruch!", vbCritical
        Exit Sub
    End Select
   
    'Alle bisherigen Daten löschen
    Intersect(Dest.CurrentRegion, Dest.EntireColumn).ClearContents
   
    'Neue Daten schreiben, falls Filter gesetzt
    If Not SC.FilterCleared Then
      For Each SI In SC.SlicerItems
        If SI.Selected Then
          Dest = SI.Value
          Set Dest = Dest.Offset(1)
        End If
      Next
    End If
  Next
End Sub