Zellen einfügen (Liste tw. aus Pivotdaten)

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub Pivotdatenaufbereiten() Dim wksPivot As Worksheet Dim wksZiel As Worksheet Dim Zeile As Long Set wksPivot = ActiveWorkbook.Worksheets("Tabelle2") 'Tabelle mit Pivotbericht Set wksZiel = ActiveWorkbook.Worksheets("Tabelle3") 'Ziel-Tabelle 'Altendaten in Zieltabelle löscehn With wksZiel Zeile = .Cells(.Rows.Count, 6).End(xlUp).Row .Range(.Rows(2), .Rows(Zeile)).Clear End With 'Formate und Daten des Pivot-Tabelle kopieren wksPivot.PivotTables(1).TableRange1.Copy wksZiel.Range("A2").PasteSpecial Paste:=xlPasteFormats wksZiel.Range("A2").PasteSpecial Paste:=xlPasteValues 'Leerzeilen für Unterthemen-Überschriften einfügen With wksZiel For Zeile = .Cells(.Rows.Count, 2).End(xlUp).Row To 3 Step -1 If Not IsEmpty(.Cells(Zeile, 2)) Then .Rows(Zeile + 1).Insert End If Next End With End Sub

Sub Pivotdatenaufbereiten() Dim wksPivot As Worksheet Dim wksZiel As Worksheet Dim Zeile As Long Set wksZiel = ActiveWorkbook.Worksheets("Tabelle3") 'Ziel-Tabelle Set wksPivot = ActiveWorkbook.Worksheets("Tabelle2") 'Tabelle mit Pivotbericht 'Altendaten in Zieltabelle löscehn With wksZiel Zeile = .Cells(.Rows.Count, 2).End(xlUp).Row .Range(.Rows(2), .Rows(Zeile)).Clear '2 = Zeile ab der Altdaten gelöscht werden sollen End With 'Formate und Daten des Pivot-Tabelle kopieren wksPivot.PivotTables(1).TableRange1.Copy wksZiel.Range("A2").PasteSpecial Paste:=xlPasteFormats 'A2 = Zelle ab der Daten eingefügt _ werden sollen wksZiel.Range("A2").PasteSpecial Paste:=xlPasteValues 'Leerzeilen für Unterthemen-Überschriften einfügen With wksZiel For Zeile = .Cells(.Rows.Count, 2).End(xlUp).Row To 3 Step -1 '3 = oberste Zeile vor _ der Daten eingefügt werden sollen If .Cells(Zeile, 1) "" And .Cells(Zeile + 1, 2) "" Then .Rows(Zeile + 1).Insert End If Next End With End Sub

Guten Morgen Franz,
Die Namen der Tabellenblätter musst du natürlich anpassen.In der Datei muss sowohl das Tabellenblatt mit dem Pivotbericht als auch ein Zielblatt für die aufbereiteten Daten.
..Daniel: Erledigt und Verstanden
Ansonsten Makro-Code mal genau Zeile für Zeile lesen und nachvollziehen, um Funktionen nach zuvollziehen. Dann sollten auch die Stellen klar werden, wo du ggf. anpassen musst.
Ich hab noch ein paar Kommentarzeilen eingefügt.
..Daniel: Hab ich mit meinen Mitteln versucht, glaube aber wir müssen nochmal einen Schritt zurück. Sorry dafür schonmal vorab.
Ich hatte dir hier als Beispiel bereits das Ergebnis reingelegt, das ich aus Pivottabelle und Formeln geniere. Der VBA Code bezieht sich aber direkt auf die Pivottabelle soweit ich das verstehe und daher sollte diese Datenstruktur berücksichtigt werden.
Habe versucht den Code mit Zeilen etc. anzupassen, bin aber gescheitert. Daher die Bitte ob du dich der Sache nochmal annehmen kannst.
Hier die Struktur der Pivottabelle (übrigens aktuell auch das Ergebnis des Makros, dieses bildet mom. 1:1 die Struktur der Pivottabelle nach: https://www.herber.de/bbs/user/88866.xlsx
Wie du erkennen kannst sind in der Pivottabelle zusätzliche Spalten, die ich in meinem Ergebnis anders darstelle.
Ich hoffe ich kann dann die Unterschiede zum bisherigen Code erkennen und bei Änderungen der Pivottabelle (z.B. zusätzliche Spalten) die Anpassungen selber vornehmen.
Danke Dir Franz
VG, Daniel

Hallo Daniel,
ich hab das Makro jetzt in 2 Makros aufgeteilt.
1: Kopieren der Pivottabellendaten
2: Aufbereiten der kopierten Daten
Ich hab zusätzliche Variablen definiert in denen Werte für Zeile_1 und Prüfspalte vorgegeben werden.
Die Prüfungen für das Einfügen einer Leerzeile mußte ich nochmals anpassen an den Aufbau der kopierten Daten.
Gruß
Franz

Sub PivotdatenKopieren()
Dim wksPivot As Worksheet
Dim wksZiel As Worksheet
Dim Zeile As Long, Zeile_1 As Long
Set wksZiel = ActiveWorkbook.Worksheets("Tabelle3") 'Ziel-Tabelle
Set wksPivot = ActiveWorkbook.Worksheets("Tabelle2") 'Tabelle mit Pivotbericht
Zeile_1 = 2 'Zeile ab der Daten gelöscht/eingefügt werden sollen
'Altdaten in Zieltabelle löschen
With wksZiel
'letzte benutzte Zeile im Tabellenblatt (Werte/Formeln/Formate)
Zeile = .UsedRange.Row + .UsedRange.Rows.Count - 1
If Zeile >= Zeile_1 Then
.Range(.Rows(Zeile_1), .Rows(Zeile)).Clear
End If
End With
'Formate und Daten der Pivot-Tabelle kopieren
wksPivot.PivotTables(1).TableRange1.Copy
wksZiel.Cells(Zeile_1, 1).PasteSpecial Paste:=xlPasteFormats
wksZiel.Cells(Zeile_1, 1).PasteSpecial Paste:=xlPasteValues
wksZiel.Activate
Call KopiertePivotdatenaufbereiten 'diese Zeile ggf. rausnehmen
End Sub
Sub KopiertePivotdatenaufbereiten()
Dim wksZiel As Worksheet
Dim Zeile As Long, Zeile_1 As Long, Spalte_S As Long
Set wksZiel = ActiveWorkbook.Worksheets("Tabelle3") 'Ziel-Tabelle
Zeile_1 = 4 'Zeile ab der ggf. Leerzeilen eingefügt werden sollen
Spalte_S = 2 'Spalte B = Spalte mit den zu suchenden Texten
'Leerzeilen für Unterthemen-Überschriften einfügen
With wksZiel
For Zeile = .Cells(.Rows.Count, Spalte_S).End(xlUp).Row To Zeile_1 Step -1
'prüfen, ob links von der zu prüfenden Spalte kein Text steht und _
in der Prüfspalte Text steht
If .Cells(Zeile, Spalte_S - 1) = "" And .Cells(Zeile, Spalte_S)  "" Then
'Leerzeile unterhalb der Zeile einfügen
.Rows(Zeile + 1).Insert
End If
Next
End With
End Sub

Beliebteste Forumthreads (12 Monate)

Zellen einfügen (Liste tw. aus Pivotdaten)

7
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

309 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Zellen einfügen (Liste tw. aus Pivotdaten)

7 Beiträge zum Forumthread Beiträge zu diesem Forumthread

309 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

7
Beiträge zum Forumthread

Beiträge zu diesem Forumthread