Makro Kopieren Einfügen inkl. Formartierungen

Question

Liebe VBA - Nutzer,

ich habe folgendes Problem.
Folgendes einfaches Makro habe ich erstellt:

Private Sub CommandButton21_Click()
Sheet3.Range("F15:G24") = Tabelle1.Range("A3:B12").Value
Sheet3.Range("B15:C24") = Sheet13.Range("A15:B24").Value
Sheet3.Range("F23:J28") = Sheet6.Range("A3:E8").Value
Sheet3.Range("F39:H90") = Tabelle2.Range("A4:C55").Value
Sheet3.Range("B39:D90") = Sheet14.Range("A15:C66").Value
Sheet3.Range("F95:H124") = Tabelle3.Range("A4:C43").Value
Sheet3.Range("B94:D123") = Sheet15.Range("A15:C44").Value
End Sub

Wie ihr sieht, werden die Werte aus verschiedenen Tabellen übernommen.
Mein Problem:
Ich möchte nicht nur die Werte, sondern auch die Formartierungen im Sheet3 mmitübernehmen.

Noch etwas: Die Daten aus der rechten Seite des Makros kommen direkt aus Pivot-Tabellen.

Schon jetzt vielen Dank für Eure Hilfe.

Gruß
Max

Answer 1

Hallo Max,

ich nehme mal an, dass Tabelle1, Tabelle2, Tabelle2 sowie Sheet3, Sheet6, Sheet13, Sheet14 und Sheet15 Tabellen in deinen Arbeitsblättern sind.

Wenn du Werte und Formatierungen übernehmen willst, dann schreibe statt

Sheet3.Range("F15:G24") = Tabelle1.Range("A3:B12").Value

den folgenden Code:

Tabelle1.Range("A3:B12").Copy
With Sheet3.Range("F15")
.PasteSpecial Paste:=xlPasteValues
.PasteSpecial Paste:=xlPasteFormats
End With

Entsprechend änderst du die anderen Zeilen in deinem Code.
Vor End Sub ergänze noch die folgende Zeile:

Application.CutCopyMode = False

Damit wird die Kopierauswahl aufgehoben.

Gruß

M.O.

Answer 2

Hallo M.O.
vielen lieben Dank für die Rückantwort.
Damit habe ich ein Teil des Problems gelöst.

Das ist der von mir verwendete Quelltext:

Tabelle3.Range("A4:C43").Copy
With Sheet3.Range("F95")
.PasteSpecial Paste:=xlPasteValues
.PasteSpecial Paste:=xlPasteFormats
End With

Application.CutCopyMode = False

Mit Hilfe Deines Quelltextes bekomme ich folgende Darstellung angezeigt:

Area Business Total
5566 3A 5.000.000,00
15B 60.000,00
2A 4.000.000,00
5566 Total 9.060.000,00
5577 3A -1.000,00
15B 250.000,00
2A 70.000,00
4Z 650.000,00
5577 Total 969.000,00
Grand Total 10.029.000,00

Ich hätte zusätzlich gerne, dass beispielsweise die erste und letzte Zellen-Zeile farblich befüllt werden und die Total-Spalten fett und mit Linien (oben/unten) hervorgehoben werden. (leider kann ich keine Bilder hinzufügen, aber es sollte so sein, wie eine Pivot-Darstelung.

Ich hoffe Du kannst mir weiterhelfen.

Vielen Dank und Gruß,
Max

Answer 3

Hallo Max,

also bei meinen Test werden mit dem Code auch die Formatierungen der Pivot-Tabelle (z.B. farbiger Hintergrund der Kopfzeilen und der Zeile mit der Gesamtsumme, Rahmen etc.) beim Kopieren übernommen.

Allerdings spreche ich mit meinem Beispielcode die einzelnen Blätter an:

Worksheets("Tabelle3").Range("A4:C43").Copy
With Worksheets("Sheet3").Range("F95")
.PasteSpecial Paste:=xlPasteValues
.PasteSpecial Paste:=xlPasteFormats
End With
Application.CutCopyMode = False

Probier das mal so aus. Statt wie im Beispiel "Tabelle3" und "Sheet3" musst du ggf. natürlich die Namen der entsprechenden Arbeitsblätter angeben.

Falls das nicht klappt, dann kannst du ja vielleicht mal eine Beispieltabelle auf einem Hoster deiner Wahl (z.B. hier) hochladen und den Link hier posten. In der Tabelle sollten ein paar Dummy-Daten drin sein, sonst sollte sie aber dem Aufbau deiner richtigen Tabelle gleichen.

Gruß

M.O.

Answer 4

Hallo M.O.
Vielen Dank für den veränderten Quelltext.
Leider werden immer noch keine Formartieren übernommen.

Ich habe eine Beispiel-Tabelle hochgeladen:

http://www75.zippyshare.com/v/W4bXBw4w/file.html

Ich hoffe, es hilft weiter.

Nochmals Danke im Voraus für Deine Mühe

VG
Max

Answer 5

Hallo Max,

in einem Rutsch kopieren und Werte und Formatierungen übernehmen funktioniert wirklich nicht. Hängt wohl damit zusammen, dass eine Pivot-Tabelle kopiert werden soll.

Kopiert man die ganze Pivot-Tabelle (also im Beispiel ab Zeile 1) und fügt sie einfach ein, so wird zwar die Formatierung übernommen, aber auch eine neue Pivot-Tabelle im Zielblatt erstellt.

Kopiert man die jeweiligen Zeilen jedoch einzeln, dann bekommt man das gewünschte Ergebnis. Hier mal das geänderte Makro:

Private Sub CommandButton21_Click()

Dim lngZeile As Long

'Bildschirmaktualisierung ausschalten:
Application.ScreenUpdating = False

Sheet3.Range("F15:G24,B15:C24,F23:J28,F39:H90,B39:D90,F95:H124,B94:D123").ClearContents

'jede Zeile einzeln kopieren; Bereich A4 bis C43
For lngZeile = 4 To 43
With Worksheets("5.3 CO Business Areas")
.Range(.Cells(lngZeile, 1), .Cells(lngZeile, 3)).Copy
End With
'Einfügen ab F95
With Worksheets("Rico").Cells(lngZeile + 91, 6)
.PasteSpecial Paste:=xlValues
.PasteSpecial Paste:=xlPasteFormats
End With
Next lngZeile

Application.CutCopyMode = False

'Bildschirmaktualisierung einschalten:
Application.ScreenUpdating = True

End Sub

Für die anderen Bereiche müsstest du das entsprechend machen.

Gruß

M.O.

Answer 6

Danke sehr

Hat perfekt funktioniert :-)