Bearbeitung beschleunigen
28.03.2016 10:06:48
Tippi
Ich habe eine Tabelle mit ca.1500 Datensätzen und es dauert sehr lang bis die Bearbeitung abgeschlossen ist
Da ich kaum VBA kenntnisse habe jetzt meine Frage:
Kann man die Bearbeitung beschleunigen und den Code vereinfachen
vielen Dank im voraus
Private Sub CommandButton1_Click()
Application.ScreenUpdating = False
Dim myRow As Long
Dim myLastRow1 As Long
Dim myLastRow2 As Long
With Sheets("Hilfstabelle")
myLastRow1 = .Cells(Rows.Count, 4).End(xlUp).Row
If myLastRow1 < 1 Then Exit Sub
End With
For myRow = 2 To myLastRow1
If Sheets("Hilfstabelle").Cells(myRow, 4).Value > 0 Then
With Sheets("Grundbuch")
myLastRow2 = .Cells(Rows.Count, 4).End(xlUp).Row
If myLastRow2 < 1 Then myLastRow2 = 11
End With
Sheets("Hilfstabelle").Rows(myRow).Copy
Sheets("Grundbuch").Rows(myLastRow2 + 1).PasteSpecial Paste:=xlValues
End If
Next myRow
With Sheets("Hilfstabelle")
myLastRow1 = .Cells(Rows.Count, 5).End(xlUp).Row
If myLastRow1 < 1 Then Exit Sub
End With
For myRow = 2 To myLastRow1
If Sheets("Hilfstabelle").Cells(myRow, 5).Value > 0 Then
With Sheets("Grundbuch")
myLastRow2 = .Cells(Rows.Count, 5).End(xlUp).Row
If myLastRow2 < 1 Then myLastRow2 = 11
End With
Sheets("Hilfstabelle").Rows(myRow).Copy
Sheets("Grundbuch").Rows(myLastRow2 + 1).PasteSpecial Paste:=xlValues
End If
Next myRow
With Sheets("Hilfstabelle")
myLastRow1 = .Cells(Rows.Count, 6).End(xlUp).Row
If myLastRow1 < 1 Then Exit Sub
End With
For myRow = 2 To myLastRow1
If Sheets("Hilfstabelle").Cells(myRow, 6).Value > 0 Then
With Sheets("Grundbuch")
myLastRow2 = .Cells(Rows.Count, 6).End(xlUp).Row
If myLastRow2 < 1 Then myLastRow2 = 11
End With
Sheets("Hilfstabelle").Rows(myRow).Copy
Sheets("Grundbuch").Rows(myLastRow2 + 1).PasteSpecial Paste:=xlValues
End If
Next myRow
MsgBox "Fertig"
Application.ScreenUpdating = True
End Sub