Live-Forum - Die aktuellen Beiträge
Datum
Titel
26.04.2024 15:34:42
Überlagernde Textbox-Ansicht
26.04.2024 15:27:20
Excel öffnet nach Auswahl einer Excel diese leer
26.04.2024 12:46:38
Nutzereingaben Speichern und Laden
26.04.2024 11:49:48
VAB und Bedingte Formatierung nimmt die Farbe im Makro nicht
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
1652to1656
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
1652to1656
1652to1656
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Pivot-Wertebereich kopieren

Pivot-Wertebereich kopieren
29.10.2018 09:59:57
Manuel
Hallo Zusammen,
ich möchte gerne den Wertebereich einer Pivottabelle kopieren und in eine neues Tabellenblatt einfügen.
Wenn ich dafür bspw. das gesamte Tabellenblatt kopiere, kopiert es mir auch die Pivot auf das neue Tabellenblatt. Dies ist aber nicht gewollt.
Und wenn ich eine feste Range eingebe, stehe ich vor dem Problem, dass sobald ich den Filter verändere, die länge der Pivot natürlich eine andere ist.
Kann ich dieses Problem irgendwie lösen, in dem ich dem Code sag, kopiere ab einer festen ersten Zeile und bis der letzten Zeile die noch etwas enthält?
Könnt ihr mir dafür einen Vorschlag machen? Ich bin leider Anfänger.
Vielen Dank und beste Grüße
Manuel

3
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Pivot-Wertebereich kopieren
29.10.2018 15:59:16
fcs
Hallo Manuel,
es gibt unter VBA verschiedene vordefinierte Zellbereiche eines Pivotberichts, di man in Makros verwenden kann.
LG
Franz
Sub CopyPivotRange()
Dim pvTab As PivotTable
Dim wksZ As Worksheet
Dim rngCopy As Range
On Error GoTo fehler
Set pvTab = ActiveCell.PivotTable 'oder Activsheet.Pivottables(1)
Set rngCopy = pvTab.TableRange1  'gesamte Pivottabelle ohne Seitenfelder
'Set rngCopy = pvTab.TableRange2 'gesamte Pivottabelle mit Seitenfelder
'Set rngCopy = pvTab.DataBodyRange'nur Datenbereich der Pivottablle
'Set rngCopy = pvTab.ColumnRange 'nur Spaltentitel-Bereich der Pivottablle
'Set rngCopy = pvTab.DataLabelRange 'nur Zeilentitelbereich der Pivottablle
'Set rngCopy = pvTab.RowRange
'Set rngCopy = pvTab.PageRange
'Set rngCopy = pvTab.PageRangeCells
Set wksZ = ActiveWorkbook.Worksheets.Add(After:=ActiveSheet)
rngCopy.Copy
With wksZ.Range("A1")
.PasteSpecial xlPasteColumnWidths
.PasteSpecial xlPasteFormats
.PasteSpecial xlPasteValues
End With
Application.CutCopyMode = False
fehler:
With Err
Select Case .Number
Case 0
Case 1004
MsgBox "Vor dem Start des Makros Zelle in zu koperender Pivot-Tabelle plazieren"
Case Else
MsgBox "Fehler-Nr. " & .Number & vbLf & .Description, vbOKOnly, "Makro:  _
CopyPivotRange"
End Select
End With
End Sub

Anzeige
AW: Pivot-Wertebereich kopieren
30.10.2018 09:57:04
Manuel
Hallo Franz,
erstmal vielen Dank für deine Mühe!
Mir hat das bereits sehr geholfen. Allerdings kommt bei mir immer ein Fehler wenn ich am Ende des Codes, den Namen des Tabellenblatts anpassen will. Dein Code generiert ja ein neues Tabellenblatt, dies heißt dann z.B. Tabellenblatt 7,...Ziel wäre z.B. dass es heißt, "Auswertung", aber da setzt dann der Code aus.
Kannst Du mir dabei nochmal helfen? Danke!!
Das war mein Vorschlag:
Sub CopyPivotRange()
Dim pvTab As PivotTable
Dim wksZ As Worksheet
Dim rngCopy As Range
On Error GoTo fehler
Set pvTab = ActiveCell.PivotTable 'oder Activsheet.Pivottables(1)
Set rngCopy = pvTab.TableRange1  'gesamte Pivottabelle ohne Seitenfelder
'Set rngCopy = pvTab.TableRange2 'gesamte Pivottabelle mit Seitenfelder
'Set rngCopy = pvTab.DataBodyRange'nur Datenbereich der Pivottablle
'Set rngCopy = pvTab.ColumnRange 'nur Spaltentitel-Bereich der Pivottablle
'Set rngCopy = pvTab.DataLabelRange 'nur Zeilentitelbereich der Pivottablle
'Set rngCopy = pvTab.RowRange
'Set rngCopy = pvTab.PageRange
'Set rngCopy = pvTab.PageRangeCells
Set wksZ = ActiveWorkbook.Worksheets.Add(After:=ActiveSheet)
rngCopy.Copy
With wksZ.Range("A1")
.PasteSpecial xlPasteColumnWidths
.PasteSpecial xlPasteFormats
.PasteSpecial xlPasteValues
End With
Application.CutCopyMode = False
fehler:
With Err
Select Case .Number
Case 0
Case 1004
MsgBox "Vor dem Start des Makros Zelle in zu koperender Pivot-Tabelle plazieren"
Case Else
MsgBox "Fehler-Nr. " & .Number & vbLf & .Description, vbOKOnly, "Makro:  _
CopyPivotRange"
End Select
End With
ActiveSheet.Name = "Auswertung" 'HIER ist die Änderung die ich vorgenommen habe, aber es kommt  _
ein Fehler
End Sub

Anzeige
AW: Pivot-Wertebereich kopieren
02.11.2018 16:44:08
fcs
Hallo Manuel,
eiegentlich sollte deine Lösung funktionieren. Aber Fehler kommt natürlich, wenn Blatt mit dem Namen schon vorhanden.
So sollte es funktionieren mit entsprechender Fehlermeldung.
LG
Franz# 

Sub CopyPivotRange()
Dim pvTab As PivotTable
Dim wksZ As Worksheet
Dim rngCopy As Range
Dim iFehler As Integer
Dim msgText$, msgTitle$
On Error GoTo fehler
iFehler = 1
Set pvTab = ActiveCell.PivotTable 'oder Activsheet.Pivottables(1)
Set rngCopy = pvTab.TableRange1  'gesamte Pivottabelle ohne Seitenfelder
'Set rngCopy = pvTab.TableRange2 'gesamte Pivottabelle mit Seitenfelder
'Set rngCopy = pvTab.DataBodyRange'nur Datenbereich der Pivottablle
'Set rngCopy = pvTab.ColumnRange 'nur Spaltentitel-Bereich der Pivottablle
'Set rngCopy = pvTab.DataLabelRange 'nur Zeilentitelbereich der Pivottablle
'Set rngCopy = pvTab.RowRange
'Set rngCopy = pvTab.PageRange
'Set rngCopy = pvTab.PageRangeCells
iFehler = 2
Set wksZ = ActiveWorkbook.Worksheets.Add(After:=ActiveSheet)
wksZ.Name = "Auswertung"
rngCopy.Copy
iFehler = 3
With wksZ.Range("A1")
.PasteSpecial xlPasteColumnWidths
.PasteSpecial xlPasteFormats
.PasteSpecial xlPasteValues
End With
Application.CutCopyMode = False
fehler:
With Err
msgText = "FehleröNr.: " & .Number & vbLf & .Description
msgTitle = "Makro: Copy_PivotRange-Fehler"
Select Case .Number
Case 0
Case 1004
Select Case iFehler
Case 1
msgText = msgText & vbLf _
& "Vor dem Start des Makros Zelle in zu koperender Pivot-Tabelle plazieren"
MsgBox msgText, vbOKOnly + vbInformation, msgTitle
Case 2
msgText = msgText & vbLf & "Blatt ""Auswertung"" ist bereits vorganden. Weiter?" _
If MsgBox(msgText, vbYesNo + vbQuestion, msgTitle) = vbYes Then
Resume Next
Else
Application.DisplayAlerts = False
wksZ.Delete
Application.DisplayAlerts = True
End If
Case Else
MsgBox msgText, vbOKOnly, msgTitle
End Select
Case Else
MsgBox msgText, vbOKOnly, msgTitle
End Select
End With
End Sub

Anzeige

Links zu Excel-Dialogen

Label

Beliebteste Forumthreads (12 Monate)

Anzeige
Jetzt das Excel-Portal bewerten: Deine Stimme zählt!

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige