VBA Copy Paste

[diving_excel]

Guten Abend zusammen!

Ich habe eine Frage zu einem VBA Code mit welchen ich einige Daten von einem Sheet in ein anderes kopieren möchte:

Code:

Application.ScreenUpdating = False
Application.Calculation = xlManual
ActiveWorkbook.Sheets("Pivot").PivotTables("PivotTable1").PivotCache.Refresh
ActiveWorkbook.Sheets("Pivot").Range("$A$3:$B$5000").AutoFilter Field:=2, Criteria1:="1"
ActiveWorkbook.Sheets("Pivot").Range("C3:C5000").Copy
ActiveWorkbook.Sheets("Sheet1").Range("H21").PasteSpecial Paste:=xlPasteValues
ActiveWorkbook.Sheets("Pivot").Range("$A$3:$B$5000").AutoFilter Field:=2
Application.Calculation = xlAutomatic
Application.ScreenUpdating = True

An sich hat alles gut geklappt, allerdings braucht er sehr lange um die Daten zu kopieren (90 Sekunden). Es scheint so als läge das Problem bei folgender Zeile (wenn ich diese Zeilen aus dem Code entferne beträgt die Laufzeit nur noch 2 Sekunden):

Code:

ActiveWorkbook.Sheets("Pivot").Range("C3:C5000").Copy
ActiveWorkbook.Sheets("Sheet1").Range("H21").PasteSpecial Paste:=xlPasteValues

Habt ihr eine Idee was ich falsch mache, bzw. was ich verbessern könnte? AN sich sind 5000 Zellen ja nicht die Welt in Excel, weshalb es mich sehr wundert wieso der Code so lange braucht.

Vielen Dank und noch einen schönen Abend!

Gruß

[schauan]

Hallöchen,

probier mal

ActiveWorkbook.Sheets("Sheet1").Range("H21:H5018").Value = ActiveWorkbook.Sheets("Pivot").Range("C3:C5000").Value

[diving_excel]

Danke klappt super und nahezu ohne Wartezeit! 

Eine Frage hätte ich noch: Mit deiner Methode werden generell alle Zellen im Range von C3:C5000 aus dem Sheet "PivotTable1" kopiert. Jetzt gibt es einige Leerzeilen, welche ich gerne nicht mit kopieren würde. Dafür filter ich die Spalte C in "PivotTable1" vorher entsprechend.

Lässt sich dein Code nun so erweitern, dass nur tatsächlich die Werte kopiert werden, die nach dem Filtern sichtbar sind?

Edit: Der Grund für meinen langsamen Code lag wohl an den ausgeblendeten Leerzeilen.


Danke & Gruß

[schauan]

Hallöchen,

theoretisch wäre das ja gut zu gebrauche, aber praktisch geht's wohl nicht Das würde nur beim Kopieren verarbeitet.

ActiveWorkbook.Sheets("Sheet1").Range("H21:H5018").Value = ActiveWorkbook.Sheets("Pivot").Range("C3:C5000").SpecialCells(xlCellTypeVisible).Value

Du müsstest ggf. im Nachgang z.B. auch im Ziel per Filter die leeren anzeigen und dann löschen

[diving_excel]

Hm aber die Idee ist gut,
werde das jetzt wie folgt lösen:

1. Werte aus der Pivot Tabelle in einem anderen Sheet zwischenspeichern
2. Leere Zeilen löschen
3. Werte mit deinem Code ins Ziel einfügen


nach dem ersten Test ging das eigentlich relativ schnell (5 Sekunden).


Danke und noch ein schönes Wochenende!