Clever-Excel-Forum

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ß

Hallöchen,

probier mal

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

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ß

Hallöchen,

theoretisch wäre das ja gut zu gebrauche, aber praktisch geht's wohl nicht Sad

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

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!

diving_excel

schauan

diving_excel

schauan

diving_excel