|
Guten Tag an das Forum,
ich habe ein Makro erstellt (siehe unten) das Funktioniert auch ganz gut.
Allerdings ist es sehr langsam, bei einer Übergabe von 5000 Zeilen benötigt es ca. 40 Minuten.
Meine Frage kann man das Beschleunigen oder habe ich hier ein Fehler drin?
Sub Übergabe_Kalku()
Application.EnableEvents = False 'Bildschirm abschalten
' Übergibt die Werte der Ausarbeitung an die Kalkulation
On Error Resume Next 'Fehler beim Auftreten unterdrücken und das Makro weiterlaufen lassen
Worksheets("Ausarbeitung").Unprotect Password:="xxx" 'Blattschutz AUS
Worksheets("Kalkulation").Unprotect Password:="xxx" 'Blattschutz AUS
Dim lr As ListRow
Dim lo1 As ListObject
Dim lo2 As ListObject
Dim zMax1 As Long
Dim zMax2 As Long
Dim diff As Long
Dim i As Long
Set lo1 = Worksheets("Ausarbeitung").ListObjects("Tab_Ausarbeitung")
Set lo2 = Worksheets("Kalkulation").ListObjects("Tab_Kalkulation")
zMax1 = lo1.ListRows.Count
zMax2 = lo2.ListRows.Count
diff = zMax1 - zMax2
If diff > 0 Then
For i = 1 To diff
Set lr = lo2.ListRows.Add
Next i
ElseIf diff < 0 Then
For i = zMax2 To zMax2 + diff Step -1
lo2.ListRows(i).Delete
Next i
End If
Range("Tab_Kalkulation[Pos.]").Value = Range("Tab_Ausarbeitung[Pos.]").Value
Range("Tab_Kalkulation[KD Text 1]").Value = Range("Tab_Ausarbeitung[KD Text 1]").Value
Range("Tab_Kalkulation[Lieferant]").Value = Range("Tab_Ausarbeitung[Lieferant]").Value
Range("Tab_Kalkulation[Sonepar-Nr.]").Value = Range("Tab_Ausarbeitung[Sonepar-Nr.]").Value
Range("Tab_Kalkulation[Artikeltext]").Value = Range("Tab_Ausarbeitung[Artikeltext]").Value
Range("Tab_Kalkulation[Hersteller Artikel-Nr.]").Value = Range("Tab_Ausarbeitung[Hersteller Artikel-Nr.]").Value
Range("Tab_Kalkulation[Menge]").Value = Range("Tab_Ausarbeitung[Menge]").Value
Range("Tab_Kalkulation[PE]").Value = Range("Tab_Ausarbeitung[PE]").Value
Range("Tab_Kalkulation[ME]").Value = Range("Tab_Ausarbeitung[ME]").Value
Worksheets("Ausarbeitung").Protect Password:="xxx" 'Blattschutz EIN
Worksheets("Kalkulation").Protect Password:="xxx" 'Blattschutz EIN
Application.EnableEvents = True ' Bildschierm einschalten
End Sub
Ich würde mich freuen wenn mir jemand Hefen könnte, meine Erfahrungen mit VBA sind da nicht ausreichend.
Vielen Dank in voraus.
Björn
|