VBA - Kopierschleife langsam- Optimierungsmöglichkeit?

[Nico_B]

Hallo.

Ich möchte von einem Tabellenblatt, auf dem ich Plandaten erfasst habe, spezifisch je Projekt auf ein anderes Tabellenblatt kopieren, um von diesem dann Uploads in eine Datenbank zu realiseren. Der Kopiervorgang erscheint mir jedoch langsam. Vielleicht hat jemand einen Optimierungsvorschlag.

Sub Importdaten_kopieren()

Dim i As Long, j As Long
Dim AR1 As Integer, AR2 As Integer
Dim sw As Variant

'Parameter für den Zielbereich
eZ1 = Worksheets("Optionen").Range("B208").Value 'erste Zeile
lZ1 = Worksheets("Optionen").Range("B209").Value 'letze Zeile
eS1 = Worksheets("Optionen").Range("B202").Value 'erste Spalte
lS1 = Worksheets("Optionen").Range("B203").Value 'letzte Spalte

'Quelldaten
AR1 = Worksheets("Optionen").Range("B30").Value   'erste Zeile der Quelldaten
AR2 = Worksheets("Optionen").Range("B31").Value   'letzte Zeile der Quelldaten

'Suchwert
sw = Worksheets("Kopieren_Access").Range("B4").Value

j = eZ1

With Application
  .ScreenUpdating = False
  .EnableEvents = False
  .Calculation = xlCalculationManual
End With

Range(eS1 & eZ1 & ":" & lS1 & lZ1).ClearContents

With Worksheets("Planung")
    For i = AR1 To AR2
        If .Cells(i, 3) = sw Then
            .Range("A" & i).Copy
                 Worksheets("Kopieren_Access").Range("A" & j).PasteSpecial Paste:=xlPasteValues
            .Range("B" & i).Copy
                 Worksheets("Kopieren_Access").Range("B" & j).PasteSpecial Paste:=xlPasteValues
            .Range("G" & i).Copy
                 Worksheets("Kopieren_Access").Range("C" & j).PasteSpecial Paste:=xlPasteValues
            .Range("H" & i).Copy
                 Worksheets("Kopieren_Access").Range("D" & j).PasteSpecial Paste:=xlPasteValues
            .Range("I" & i).Copy
                 Worksheets("Kopieren_Access").Range("E" & j).PasteSpecial Paste:=xlPasteValues
            .Range("J" & i).Copy
                 Worksheets("Kopieren_Access").Range("F" & j).PasteSpecial Paste:=xlPasteValues
            .Range("K" & i).Copy
                 Worksheets("Kopieren_Access").Range("G" & j).PasteSpecial Paste:=xlPasteValues
            j = j + 1
        End If
    Next i
End With

' letzte zeile Ermitteln
l = Worksheets("Kopieren_Access").UsedRange.SpecialCells(xlCellTypeLastCell).Row
' wert in zelle schreiben
Worksheets("Optionen").Range("B209").Value = l

Range(eS1 & eZ1 & ":" & lS1 & lZ1).Sort Key1:=Range(eS1 & eZ1), Order1:=xlAscending, Header:=xlYes

With Application
  .ScreenUpdating = True
  .EnableEvents = True
  .Calculation = xlCalculationAutomatic
End With

End Sub

men werden, die spezifischen Plandaten für ein Projekt kopieren, um diese dann in eine Datenbank upzuloaden. Der Kopiervorgang scheint mir jedoch langsam. Vielleicht hat jemand eine Optimierungsmöglichkeit:

 

[Gameforce]

du könntest evtl die zu kopierenden Zellen mit jeweils nur einer Zeile Code kopieren und einfügen. Dann steuerst Du nicht jede Zelle einzeln an.


With Worksheets("Planung")
For i = AR1 To AR2
If .Cells(i, 3) = sw Then
.Range("A" & i, "B" & i,"G" & i, "H" & i, "I" & i, "J" & i, "K" & i).Copy
Worksheets("Kopieren_Access").Range("A" & j,"B" & j,"C" & j,"D" & j,"E" & j,"F" & j,"G" & j ).PasteSpecial Paste:=xlPasteValues
j = j + 1
End If
Next i

Evtl. beschleunigt das den Kopiervorgang.

 

[Scientist]

Statt zeilenweise jeden Wert einzeln zu kopieren, waere es doch sinnvoller die entsprechenden Daten in der jeweiligen Spalte als ganzes zu kopieren ...

Ansonsten:

• Bereiche soweit wie moeglich zusammenfassen.
• .Cells() ist schneller als .Range (Auswirkungen haengen natuerlich von der Masse ab)

---

Nachtrag:
Okay, ich hab gerade ebend erst die Ausnahme gesehen ...
Man koennte den kompletten Bereich gefiltert nach "sw" (Spezialfilter) uebertragen und dann die Spalten loeschen und den editierten Bereich in die Tabelle einfuegen.

Handelt es sich um zwei forlaufende Listen?
Von wie vielen Eintraegen reden wir hier?
Was heißt langsam?
Warum VBA und nicht Pivot?