[VBA] Makro verkürzen

[Rabe]

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

[LuckyJoe]

Hi Rabe,

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

Viel Erfolg!

[snb]

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

[Rabe]

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.

[Rabe]

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.

[BoskoBiati]

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!!!

[Kuwer]

Hi Edgar,

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

Gruß Uwe

[Rabe]

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!

[BoskoBiati]

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

[Rabe]

Hi,

danke. So klappt es.

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