Pivottabelle mit Wert überschreiben

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub Pivot_ins_Archiv_1() Dim wks As Worksheet, wkbArchiv As Workbook Dim rngPivot As Range Set wks = ActiveSheet If wks.PivotTables.Count > 0 Then Set rngPivot = wks.PivotTables(1).TableRange2 Set wkbArchiv = Application.Workbooks.Add(Template:=xlWBATWorksheet) With wkbArchiv.Worksheets(1) rngPivot.Copy With .Range("A1") 'EinfügeZelle ggf. anpassen .PasteSpecial Paste:=xlPasteColumnWidths 'Spaltenbreiten einfügen .PasteSpecial Paste:=xlPasteFormats 'Formate einfügen .PasteSpecial Paste:=xlPasteValues 'Werte einfügen End With Application.CutCopyMode = False .Name = wks.Name Range("A1").Select End With Else MsgBox "Tabellenblatt """ & wks.Name & """ enthält keinen Pivottabellenbericht!", _ vbOKOnly, "Makro: Pivot_ins_Archiv" End If End Sub

Sub PivotChart_ins_Archiv_1() Dim wks As Worksheet, wkbArchiv As Workbook Dim objChart As ChartObject Set wks = ActiveSheet If wks.ChartObjects.Count > 0 Then Set objChart = wks.ChartObjects(1) Set wkbArchiv = Application.Workbooks.Add(Template:=xlWBATWorksheet) With wkbArchiv.Worksheets(1) Range("B2").Select 'Einfüge-Zelle für Diagramm (linke-obere Ecke) objChart.Copy .Paste .Name = wks.Name Range("A1").Select End With Else MsgBox "Tabellenblatt """ & wks.Name & """ enthält kein eingebettetes Diagramm!", _ vbOKOnly, "Makro: Pivothrt_ins_Archiv" End If End Sub

Hallo Ralf,
ich hab das Makro angepasst.
Beim Kopieren des Pivot-Diagramms in eine andere Mappe geht die Verknüpfung automatisch verloren.
Deshalb hab ich diesen Weg beibehalten.
Das Original-Diagrmm wird dann gelöscht, das Diagramm aus der neuen Mappe zurückkopiert und die neue Mappe geschlossen ohne speichern.
Gruß
Franz

Sub PivotChart_ins_Archiv_1()
Dim wks As Worksheet, wkbArchiv As Workbook
Dim objChart As ChartObject, Zelle As Range, lTop As Double, lLeft As Double
Set wks = ActiveSheet
With wks
If wks.ChartObjects.Count > 0 Then
Set objChart = wks.ChartObjects(1)
With objChart
Set Zelle = .TopLeftCell
lTop = .Top
lLeft = .Left
End With
Set wkbArchiv = Application.Workbooks.Add(Template:=xlWBATWorksheet)
With wkbArchiv.Worksheets(1)
Range("A1").Select 'Einfüge-Zelle für Diagramm (linke-obere Ecke)
objChart.Copy
.Paste
objChart.Delete
Set objChart = .ChartObjects(1)
End With
.Parent.Activate
Zelle.Select
objChart.Copy
.Paste
Set objChart = wks.ChartObjects(1)
With objChart
.Top = lTop
.Left = lLeft
End With
wkbArchiv.Close savechanges:=False
Else
MsgBox "Tabellenblatt """ & wks.Name & """ enthält kein eingebettetes Diagramm!", _
vbOKOnly, "Makro: Pivothrt_ins_Archiv"
End If
End With
End Sub

Beliebteste Forumthreads (12 Monate)

Pivottabelle mit Wert überschreiben

10
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

12 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Pivottabelle mit Wert überschreiben

10 Beiträge zum Forumthread Beiträge zu diesem Forumthread

12 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

10
Beiträge zum Forumthread

Beiträge zu diesem Forumthread