Daten aus Pivot-Tabelle automatisiert kopieren

ActiveSheet.PivotTables("PivotTabelle").PivotFields("Feld").ClearAllFilters ActiveSheet.PivotTables("PivotTabelle").PivotFields("Feld").CurrentPage = _ "Variable" On Error Resume Next Range("A5:A1000").Select Application.CutCopyMode = False Selection.Copy Sheets("Tabellenblatt").Select Range("A1").Select ActiveSheet.Paste Sheets("PivotTabelle").Select

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Benutzer

Sub savePivot() Dim rng As Range, rngSettings As Range On Error Resume Next With Application .EnableEvents = False .ScreenUpdating = False .Calculation = xlCalculationManual End With With Sheets("Einstellungen") 'Tabellen mit den Tabellennamen in A1:Ax und den Seitennamen in B1:Bx Set rngSettings = Range("A1:B" & .Cells(.Rows.Count, 1).End(xlUp).Row) End With For Each rng In rngSettings.Rows With Sheets("PivotTabelle") With .PivotTables("PivotTabelle").PivotFields("Feld") .ClearAllFilters .CurrentPage = rng.Cells(1, 2).Text End With .Range("A5").CurrentRegion.Copy Sheets(rng.Cells(1, 1).Text).Range("A1") End With Next On Error GoTo 0 With Application .EnableEvents = True .ScreenUpdating = True .Calculation = xlCalculationAutomatic End With Set rngSettings = Nothing Set rng = Nothing End Sub

Hallo Frankl,
...... Ich habe mit großer Begeisterung festgestellt, dass im Code dies der Befehl "pvTab.TableRange1.Copy" bewirkt.
Mit "pvTab.TableRange1" wird der zu kopierende Teil/Zellbereich des Pivot-Tabellenberichtes festgelegt.
Die Art des Kopierens wird in der nachfolgenden Zeile festgelegt mit der PasteSpecial-Methode.
wksZiel.Cells(1, 1).PasteSpecial Paste:=xlPasteValues
Zum einen: Wie verhält sich der Code, wenn sich die "Tabellen-Namen" nicht im gleichen Dokument befinden, sondern lokal anderweitig gelagert sind?
Das ist grundsätzlich kein Problem. Es muss dann aber im Code noch eine Workbook-Objektvariable für die Zieldatei eingeführt werden und wksZiel (Tabellen-Objektvariable) muss in Verbindung mit dieser Variablen gesetzt werden.
In der Textdatei findest du den entsprechend angepassten Code.
In der Datei mit dem Makro befinden sich die Tabellen
PivotTabelle, Quelldaten, Einstellungen und Muster
In der Datei "Ziel.xlsx" (Name beliebig festlegbar) die Tabellenblätter in die die Daten kopiert werden sollen.
Man könnte aber auch noch die Tabellen Einstellungen und Muster inklusive der Makros in eine separate Datei auslagern.
Vor der Ausführung des Makros müssen aber alle Dateien geöffnet sein, wobei man auch dies durch Einbau entsprechender Dateiauswahldialoge auch anders steuern kann.
Zum anderen: Kann ich mehrer Elemente in "Feld3" anwählen (z.B. die Feld3-Werte per Komma trennen)?
Ja, Semikolon ist aber das bessere Trennzeichen. Allerdings muss dann der Code für eine Mehrfachauswahl umgeschrieben werden. D.h. nach dem zurücksetzen des Filters müssen in der PivotItem-Liste des Berichtfeldes die nicht gewünschten Einträge in einer Schleife ausgeblendet werden.
In der Textdatei findest du die Hauptprozedur angepasst für Zieldateien in anderer Arbeitsmappe und Mehrfach-Auswahl für das 2. Berichtsfeld (Feld3).
https://www.herber.de/bbs/user/81608.txt
Gruß
Franz

Hallo Frankl,
du traust dich aber auch kein bischen ein wenig im Makro zu experimentieren.
Folgende Zeile muss du anpassen, wenn du den Namen der Zieldatei aus einer Zelle einlesen willst.


Set wbkZiel = Workbooks("Ziel.xlsx")                   'Name ggf. anpassen
'ändern in
Set wbkZiel = Workbooks(wbk.Sheets("Einstellungen").Range("L1").Value) 'Zelle ggf. anpassen

Fehlende Monate in der Auswertung.
1. Im Pivot-Bericht kannst du nichts machen. Was nicht da ist kann der Bericht nicht erfinden.
2. Datequellen anpassen - mit Dummy-Daten auffüllen.
Sehr mühselig - du müsstest ja erst einmal ermitteln, welche Daten-Kombinationen fehlen.
3. Zielblätter anpassen.
Wenn deine Zeile1 in den Zieltabellenblättern immer den identischen Aufbau und Werte hat, wie in der Grafik angezeigt, dann kann man das per Makro korrigieren.

Sub fehlende_Monate_einfuegen()
Dim wks As Worksheet
Dim lngSpalte As Long, iMonat As Integer
Dim strZeile1 As String
Dim strFeld1 As String
Dim strFeld2 As String
Set wks = ActiveSheet
With wks
'Summenfeld-Bezeichnungen in Zeile2 einlesen
strFeld1 = .Cells(2, 2).Text
strFeld2 = .Cells(2, 3).Text
'fehlende Spalten einfügen
For lngSpalte = 2 To 24 Step 2
iMonat = iMonat + 1
Select Case iMonat
Case 1: strZeile1 = "Werte Jan."
Case 2: strZeile1 = "Werte Feb."
Case 3: strZeile1 = "Werte Mar."
Case 4: strZeile1 = "Werte Apr."
Case 5: strZeile1 = "Werte Mai."
Case 6: strZeile1 = "Werte Jun."
Case 7: strZeile1 = "Werte Jul."
Case 8: strZeile1 = "Werte Aug."
Case 9: strZeile1 = "Werte Sep."
Case 10: strZeile1 = "Werte Okt."
Case 11: strZeile1 = "Werte Nov."
Case 12: strZeile1 = "Werte Dez."
End Select
If .Cells(1, lngSpalte).Value  strZeile1 Then
.Range(.Columns(lngSpalte), .Columns(lngSpalte + 1)).Insert
.Cells(1, lngSpalte).Value = strZeile1
.Cells(2, lngSpalte).Value = strFeld1
.Cells(2, lngSpalte + 1).Value = strFeld2
End If
Next
End With
End Sub

So ein Makro könnte man natürlich dann auch in die Hauptprozedur einbinden.
Gruß
Franz

Sub fehlende_Monate_einfuegen(wks As Worksheet) Dim lngSpalte As Long, iMonat As Integer Dim strZeile1 As String Dim strFeld1 As String Dim strFeld2 As String With wks 'Summenfeld-Bezeichnungen in Zeile2 einlesen

Beliebteste Forumthreads (12 Monate)

Daten aus Pivot-Tabelle automatisiert kopieren

11
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

97 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Daten aus Pivot-Tabelle automatisiert kopieren

11 Beiträge zum Forumthread Beiträge zu diesem Forumthread

97 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

11
Beiträge zum Forumthread

Beiträge zu diesem Forumthread