CurrentPage bei Pivot

Hallo zusammen,
ich habe ein recht triviales Problem. denke ich :)
möchte per Makro die Werte aus einer Pivot-Tabelle Stück für Stück in ein anderes Tabellenblatt kopieren.
Dabei möchte ich das Feld Name (CurrentPage) jeweils mit den Begriffen füllen, welche in der Zelle B17 und abwärts stehen.
Aktuell sieht es so aus:
Sheets("R 2").Select
ActiveSheet.PivotTables("PivotTable7").PivotFields("Name").CurrentPage = _
"Kunde1"
Rows("1:16").Select
Selection.Copy
ab hier komm ich zurecht ;)
Dabei soll "Kunde1" aber nicht als Text stehen, sondern aus der Zelle B17 übernommen werden.
Wie mach ich dieses Feld variabel?
B17 = Kunde1
B18 = Kunde2
B19 = Kunde3
usw.
B50 = x
schön wäre noch eine Schleife, die solange kopiert bis in Spalte B das x erreicht ist, da die Anzahl der zu kopierenden "Kunden" jedes mal anders ist.
vielen Dank für eure Hilfe

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Benutzer

Sub cccc() Dim i As Long i = 17 Do While Cells(i, 2) "x" With Sheets("R 2") .PivotTables("PivotTable7").PivotFields("Name").CurrentPage = Cells(i, 2) .Rows("1:16").Copy 'weiterer Code, mit dem du zurecht kommst ;-) End With Loop End Sub

Sub cccc() Dim i As Long i = 17 Do While Cells(i, 2).Value "" ' abruch wenn Feld leer With Sheets("R 2") .PivotTables("PivotTable7").PivotFields("Name").CurrentPage = Cells(i, 2).Value ' hier _ auch .Rows("1:16").Copy 'weiterer Code, mit dem du zurecht kommst ;-) End With Loop End Sub

hmm.,.. das funktioniert einfach nicht :-(
er fängt nicht bei B17 an,.. sonder beginnt bereits bei B 2 die Werte in das Feld Name zu übernehmen.
da kommt natürlich Blödsinn bei raus?
irgendwas müßte daher noch geändert werden?
hier noch mal der ganze Code:

Sub Einzelbericht()
'löschen altes Blatt
Sheets("Einzelbericht").Select
Cells.Select
Selection.Clear
'Schleife für Werte ab B17 (I=17, 2=B)
Dim i As Long
i = 17
Do While Cells(i, 2).Value  "x"
With Sheets("R 2")
.PivotTables("PivotTable7").PivotFields("Name").CurrentPage = Cells(i, 2).Value
.Rows("1:16").Copy
'Einfügen und anfügen
Sheets("Einzelbericht").Select
Range("A65536").Select
Selection.End(xlUp).Select
ActiveSheet.Paste
Application.CutCopyMode = False
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
i = i + 1
End With
Loop
End Sub

Beliebteste Forumthreads (12 Monate)

8 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

8
Beiträge zum Forumthread

Beiträge zu diesem Forumthread