Clever-Excel-Forum

Seiten: 1 2

Hi,

ich habe eine Datei übernommen und will die schneller machen.

Mit dem folgenden Code-Teil werden aus der Quell-Datei 10 gefilterte (325 aus 7600 Zeilen) Spalten einzeln in andere Spalten der Ziel-Datei kopiert.
Wie kann ich diesen 10 mal vorkommenden Block verkürzen?

Code:
Windows("EVG.xlsb").Activate

   Sheets("2001").Select

   Range("I:I").copy

   Windows("aktuell.xlsm").Activate

   Sheets("Rohdaten").Select

   Range("A:A").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _

       :=False, Transpose:=False

Die ganze Kopiererei versuchte ich wegzulassen, das hat aber nicht geklappt:
Workbooks("aktuell.xlsm").Sheets("Rohdaten").Range("A:A") = Workbooks("EVG.xlsb").Sheets("2001").Range("I:I")

oder so:

Code:
Workbooks("EVG.xlsb").Sheets("2001").Range("I:AB").copy

   Workbooks("aktuell.xlsm").Sheets("Rohdaten").Range("R:R").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _

       :=False, Transpose:=False

Die Spalten sind:
I nach A, D nach D, K nach V, X nach E, J nach F, H nach G, U nach J, R nach K, E nach O, AB nach R

Hi Rabe,

hilft dir diese Info dazu weiter: https://www.informatik-aktuell.de/betrie...eiten.html

Viel Erfolg!

Code:
Sub M_snb()

  for j=1 to 10

    Workbooks("EVG.xlsb").Sheets("2001").usedrange.columns(choose(j,9,4,11,24,10,8,21,18,5,28)).copy Workbooks("aktuell.xlsm").Sheets("Rohdaten").cells(1,choose(j,1,4,22,5,6,7,10,11,15,18))

  next

End Sub

Hi,

danke erst mal.

@snb: Das teste ich morgen.

@LuckyJoe:
Vielleicht schaffe ich es mit dieser Seite auch irgendwann mal, die Array-Verarbeitung zu kapieren.

Hi snb,

nun habe ich es getestet und es funktioniert.

Es werden aber die kompletten Zellen eingefügt und ich hätte gerne nur die Werte.

Bei

Code:
Sub M_snb()

  for j=1 to 10

    Workbooks("EVG.xlsb").Sheets("2001").usedrange.columns(choose(j,9,4,11,24,10,8,21,18,5,28)).copy

    Workbooks("aktuell.xlsm").Sheets("Rohdaten").cells(1,choose(j,1,4,22,5,6,7,10,11,15,18)).PasteSpecial Paste:=xlPasteValues

  next

End Sub

kommt die Fehlermeldung, daß die PasteSpecial-Methode für das Range-Objekt nicht ausgeführt werden könne.

Hi Ralf,

Makro sollte eigentlich so aussehen:

Code:
Sub M_snb()

  For j = 1 To 10

    Workbooks("EVG.xlsb").Sheets("2001").UsedRange.Columns(Choose(j, 9, 4, 11, 24, 10, 8, 21, 18, 5, 28)).Copy_ Workbooks("aktuell.xlsm").Sheets("Rohdaten").Cells(1, Choose(j, 1, 4, 22, 5, 6, 7, 10, 11, 15, 18))

  Next

End Sub

keine 2 Zeilen!!!

Hi Edgar,

(08.06.2018, 07:58)Rabe schrieb: [ -> ]Es werden aber die kompletten Zellen eingefügt und ich hätte gerne nur die Werte.

Gruß Uwe

Hi,

@Edgar
ja, so hatte ich es auch, bis ich merkte, daß es alles kopiert und nicht nur die Werte. Dann habe ich es mit PasteSpecial probiert und dann in zwei Zeilen mit PasteSpecial.
Den Stand habe ich dann hier eingefügt.

@Uwe
ja, genau!

Hi,

ich hatte nur nackte Zahlen in meiner Tabelle, deswegen ist es mir nicht aufgefallen.
Bei mir läuft es mit Deinem Code durch ohne zu mucken.
Falsch, der Code hat bei mir eine klitzekleine Änderung erfahren:

Code:
Sub M_snb()

  For j = 1 To 10

    Workbooks("EVG.xlsb").Sheets("2001").UsedRange.Columns(Choose(j, 9, 4, 11, 24, 10, 8, 21, 18, 5, 28)).Copy

    Workbooks("Aktuell.xlsm").Sheets("Rohdaten").Cells(1, Choose(j, 1, 4, 22, 5, 6, 7, 10, 11, 15, 18)).PasteSpecial Paste:=xlValues

  Next

End Sub

Hi,

danke. So klappt es.

Komisch, daß es in dem Fall nicht xlPasteValues heißt.

Seiten: 1 2

Rabe

LuckyJoe

snb

Rabe

Rabe

BoskoBiati

Kuwer

Rabe

BoskoBiati

Rabe