Top-Themen

AppleEntwicklungHardwareInternetLinuxMicrosoftMultimediaNetzwerkeOff TopicSicherheitSonstige SystemeVirtualisierungWeiterbildungZusammenarbeit

Aktuelle Themen

Administrator.de FeedbackApache ServerAppleAssemblerAudioAusbildungAuslandBackupBasicBatch & ShellBenchmarksBibliotheken & ToolkitsBlogsCloud-DiensteClusterCMSCPU, RAM, MainboardsCSSC und C++DatenbankenDatenschutzDebianDigitiales FernsehenDNSDrucker und ScannerDSL, VDSLE-BooksE-BusinessE-MailEntwicklungErkennung und -AbwehrExchange ServerFestplatten, SSD, RaidFirewallFlatratesGoogle AndroidGrafikGrafikkarten & MonitoreGroupwareHardwareHosting & HousingHTMLHumor (lol)Hyper-VIconsIDE & EditorenInformationsdiensteInstallationInstant MessagingInternetInternet DomäneniOSISDN & AnaloganschlüsseiTunesJavaJavaScriptKiXtartKVMLAN, WAN, WirelessLinuxLinux DesktopLinux NetzwerkLinux ToolsLinux UserverwaltungLizenzierungMac OS XMicrosoftMicrosoft OfficeMikroTik RouterOSMonitoringMultimediaMultimedia & ZubehörNetzwerkeNetzwerkgrundlagenNetzwerkmanagementNetzwerkprotokolleNotebook & ZubehörNovell NetwareOff TopicOpenOffice, LibreOfficeOutlook & MailPapierkorbPascal und DelphiPeripheriegerätePerlPHPPythonRechtliche FragenRedHat, CentOS, FedoraRouter & RoutingSambaSAN, NAS, DASSchriftartenSchulung & TrainingSEOServerServer-HardwareSicherheitSicherheits-ToolsSicherheitsgrundlagenSolarisSonstige SystemeSoziale NetzwerkeSpeicherkartenStudentenjobs & PraktikumSuche ProjektpartnerSuseSwitche und HubsTipps & TricksTK-Netze & GeräteUbuntuUMTS, EDGE & GPRSUtilitiesVB for ApplicationsVerschlüsselung & ZertifikateVideo & StreamingViren und TrojanerVirtualisierungVisual StudioVmwareVoice over IPWebbrowserWebentwicklungWeiterbildungWindows 7Windows 8Windows 10Windows InstallationWindows MobileWindows NetzwerkWindows ServerWindows SystemdateienWindows ToolsWindows UpdateWindows UserverwaltungWindows VistaWindows XPXenserverXMLZusammenarbeit
GELÖST

Pivottabelle als neue Datei (nicht als Pivot) speichern und Format übertragen, Blatt und Dateiname aus einer Zelle (nur einen Teil) übernehmen.

Frage Microsoft Microsoft Office

Mitglied: winget

winget (Level 1) - Jetzt verbinden

07.10.2014, aktualisiert 08.10.2014, 3066 Aufrufe, 13 Kommentare, 2 Danke

Hallo zusammen,
ich suchen nach einer VBA Lösung, die mir fogendes ermöglicht:

1. Pivottabelletabelle soll als eine neue Datei gespeichert werden, wobei das Format (Fett, Kursiv, Farbe etc) soll beibehalten werden.
2. Die Dateiname und Blattname soll aus z.B. Zelle A1 (aber nur die letzten 8 Zeichen) ausgelesen werden.

Vielen Dank im Voraus

BILD
Mitglied: colinardo
07.10.2014, aktualisiert 08.10.2014
Hallo winget,
das lässt sich machen, hier der Beispiel-Code. Anzupassen ist das Sheet (Zeile 4) auf dem die Pivottabelle liegt und der Name der Pivottabelle (Zeile 6). Der Code kopiert dann den Bereich der Pivotabelle in eine neue Arbeitsmappe (dabei wird nicht die Pivottabelle ansich kopiert sondern nur die Werte und Formate der Zellen in der Pivot, so wie du es wolltest), und speichert diese im selben Verzeichnis wie die aktuelle Mappe (das kannst du aber in Zeile 22 abändern)
01.
Sub ExportPivotTable() 
02.
    Dim ws As Worksheet, newWB As Workbook, p As PivotTable, strNewName As String 
03.
    'Tabellenblatt definieren auf dem die Pivottabelle liegt 
04.
    Set ws = Sheets(1) 
05.
    'Pivottabelle anhand Ihres Namens referenzieren 
06.
    Set p = ws.PivotTables("PivotTable1") 
07.
    'Gesamtbereich der Pivottabelle kopieren 
08.
    p.TableRange2.Copy 
09.
    'Neue Arbeitsmappe erstellen 
10.
    Set newWB = Workbooks.Add 
11.
    'Füge die Pivottabell als reine Daten mit Formatierung in die neue Mappe ein 
12.
    With newWB.Sheets(1).Range("A1") 
13.
        .PasteSpecial Paste:=xlPasteValuesAndNumberFormats 
14.
        .PasteSpecial Paste:=xlPasteFormats 
15.
        .PasteSpecial Paste:=xlPasteColumnWidths 
16.
    End With 
17.
    'Name der neuen Arbeitsmappe aus Zelle A1 des Worksheets auslesen (letzte 8 Zeichen der Zelle) 
18.
    strNewName = Right(ws.Range("A1").Value, 8) 
19.
    'Name des Sheets setzen 
20.
    newWB.Sheets(1).Name = strNewName 
21.
    'Neue Arbeitsmappe im selben Verzeichnis wie diese speichern 
22.
    newWB.SaveAs ThisWorkbook.Path & "\" & strNewName & ".xlsx" 
23.
    'neue Mappe schließen 
24.
    newWB.Close True 
25.
End Sub
Weitere Kommentare findest du im Code

Grüße Uwe
Bitte warten ..
Mitglied: winget
08.10.2014 um 10:36 Uhr
Hi Uwe,
wie immer sind deine Lösungen Klasse.
Ich habe nur ein kleines Problem.
In der Zeile 1-2 befindet sich mein Kopfbereich (die Daten sind statisch).
Wie kann ich das lösen?

Dein Code habe ich entsprechend angepasst, so dass die Daten erst ab Zelle A3 eingefügt werden.

Schon mal vielen Dank
Gruß
Paul
Bitte warten ..
Mitglied: colinardo
08.10.2014, aktualisiert um 10:40 Uhr
Zitat von winget:
In der Zeile 1-2 befindet sich mein Kopfbereich (die Daten sind statisch).
Wie kann ich das lösen?
erklär mal ... wo? in der Pivot oder woanders ?
Bitte warten ..
Mitglied: winget
08.10.2014 um 10:55 Uhr
Ja. In der Pivottabelle >in der Sheet(1)<

Zur Verdeutlichung:
A1:E2 (statische Daten) > Kopfbereich
A3:E97(Pivot Daten - dynamisch) ist aber durch ("PivotTable1") definiert bzw. referenziert.

Die Zeile 12 habe ich bereits in (A3) geändert.

Danke noch mal
Bitte warten ..
Mitglied: colinardo
08.10.2014, aktualisiert um 11:01 Uhr
Zitat von winget:
Zur Verdeutlichung:
A1:E2 (statische Daten) > Kopfbereich
Ist das Der Kopfbereich bzw. der Page-Bereich der Pivot ? und was willst du damit jetzt, willst du den nicht übernehmen oder doch ??

p.TableRange2.Copy 
kopiert die Pivot inklusive Kopfdaten (wenn ein Pivot-Page-Filter aktiviert ist)
p.TableRange1.Copy 
und das nur die Tabellendaten der Pivot
Bitte warten ..
Mitglied: winget
08.10.2014 um 11:01 Uhr
Ich will mit übernehmen!
Das ist der Page-Bereich der Pivot!
Bitte warten ..
Mitglied: colinardo
08.10.2014, aktualisiert um 11:06 Uhr
Zitat von winget:

Ich will mit übernehmen!
Das ist der Page-Bereich der Pivot!
der wird automatisch durch die Range Eigenschaft TableRange2 mit übernommen, wenn es tatsächlich der Pagebereich ist (geht hier einwandfrei, ansonsten mach mal ein Bild)
p.TableRange2.Copy
Bitte warten ..
Mitglied: winget
08.10.2014, aktualisiert um 12:04 Uhr
Hi Uwe,
ich konnte über die Seite nich hochlanden.
Ich habe das Bild bei dropbox hochgeladen. Siehe Original-Beitrag

ob mit p.TableRange2.Copy oder p.TableRange1.Copy wird immer der Bereich (Pivobereich) A3:E26 kopiert und in die neue Datei eingefügt.

Danke
Paul
Bitte warten ..
Mitglied: colinardo
08.10.2014, aktualisiert um 12:20 Uhr
ich hatte mit Pagebereich, den Kriterienbereich der Pivottabelle gemeint das ist was anderes als du vermutlich dachtest .....
egal du änderst Zeile 8 folgendermaßen ab:
ws.Range(p.TableRange2.Offset(-2, 0), p.TableRange2).Copy
und dein geändertes A3 kannst du wieder auf A1 ändern, bzw. dort wohin du die Tabelle im neuen Sheet platzieren willst.

Grüße Uwe
Bitte warten ..
Mitglied: winget
08.10.2014 um 12:27 Uhr
Kopieren funktioniert jetzt schon mal super.
Das Format für den "Kriterienbreich" wird aber nicht übertragen.

Aber das Funktioniert auch nicht, wenn man manuell die koplette Pivotabelle als Werte in einer anderen Tabelle überträgt und das das Format für die komplette Tabelle.
Für den Kriterienbereich muss man separat markieren und das Format übertragen.

Grüße
Paul
Bitte warten ..
Mitglied: colinardo
08.10.2014, aktualisiert um 12:47 Uhr
Zitat von winget:

Kopieren funktioniert jetzt schon mal super.
Das Format für den "Kriterienbreich" wird aber nicht übertragen.
Die Formatierung musst du in der Pivottabelle nochmal wiederholen damit die Formate übertragen werden, nur selber eingefügte Formatierungen werden hierbei übertragen, die Pivot ist da leider besonders zu betrachten...wenn ich noch ein Workaround finde melde ich mich...
Bitte warten ..
Mitglied: colinardo
08.10.2014, aktualisiert um 13:17 Uhr
Als Workaround kannst du es nach deinem gepostetem Bild so machen (hier wird die Formatierung des Detailbereiches dann mit übertragen):
01.
Sub ExportPivotTable() 
02.
    Dim ws As Worksheet, newWB As Workbook, p As PivotTable, strNewName As String 
03.
    'Tabellenblatt setzen auf dem die Pivottabelle liegt 
04.
    Set ws = Sheets(1) 
05.
    'Pivottabelle anhand Ihres Namens refernzieren 
06.
    Set p = ws.PivotTables("PivotTable1") 
07.
    'Bereich der Pivottabelle kopieren 
08.
    p.TableRange1.Copy 
09.
    'Neue Arbeitsmappe erstellen 
10.
    Set newWB = Workbooks.Add 
11.
    'Füge die Pivottabelle als reine Daten mit Formatierung in die neue Mappe ein 
12.
    With newWB.Sheets(1).Range("A3") 
13.
        .PasteSpecial Paste:=xlPasteValuesAndNumberFormats 
14.
        .PasteSpecial Paste:=xlPasteFormats 
15.
        .PasteSpecial Paste:=xlPasteColumnWidths 
16.
    End With 
17.
    'Kopfzeilen übertragen 
18.
    ws.Range("1:2").Copy newWB.Sheets(1).Range("A1") 
19.
     
20.
    'Name der neuen Arbeitsmappe aus Zelle A1 des Worksheets auslesen (letzte 8 Zeichen der Zelle) 
21.
    strNewName = Right(ws.Range("A1").Value, 8) 
22.
    'Name des Sheets setzen 
23.
    newWB.Sheets(1).Name = strNewName 
24.
    'Neue Arbeitsmappe im selben Verzeichnis wie diese speichern 
25.
    newWB.SaveAs ThisWorkbook.Path & "\" & strNewName & ".xlsx" 
26.
    'neue Mappe schließen 
27.
    newWB.Close True 
28.
End Sub
Bitte warten ..
Mitglied: winget
08.10.2014 um 14:37 Uhr
Das funktioniert Super...
Vielen Dank noch mal
Bitte warten ..
Neuester Wissensbeitrag
Humor (lol)

Linkliste für Adventskalender

(3)

Information von nikoatit zum Thema Humor (lol) ...

Ähnliche Inhalte
VB for Applications
gelöst VBA Text mit Format übertragen und Zeichen ergänzen (11)

Frage von Dau12345 zum Thema VB for Applications ...

Batch & Shell
Bash Script soll neue Datei erzeugen (2)

Frage von SpeakerST zum Thema Batch & Shell ...

Heiß diskutierte Inhalte
Windows Server
DHCP Server switchen (20)

Frage von M.Marz zum Thema Windows Server ...

Exchange Server
gelöst Exchange 2010 Berechtigungen wiederherstellen (20)

Frage von semperf1delis zum Thema Exchange Server ...

Hardware
gelöst Negative Erfahrungen LAN-Karten (19)

Frage von MegaGiga zum Thema Hardware ...

Exchange Server
DNS Einstellung - zwei feste IPs für Mailserver (15)

Frage von ivan0s zum Thema Exchange Server ...