Geschwindigkeit Excel

Sub DatenKopieren()
Dim Wks1 As Worksheet
Dim Wks2 As Worksheet
Dim Found As Range
Dim c As Range
Dim i As Long
Dim j As Long
Dim lgCount As Long
Set Wks1 = Sheets("Daten")
Set Wks2 = Sheets("t_Report")
Dim lastRowWks1 As Long
Dim lastRowWks2 As Long
'----------------------------------------------------------------------------------------------- _
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual
'Daten kopieren von Daten zu t_Report
With Wks1 'also in den Daten
For Each c In .Range("B2:B" & .Cells(.Rows.Count, "B").End(xlUp).Row)
If Not IsEmpty(c) Then
Set Found = Wks2.Columns("B").Find(c, LookIn:=xlValues, LookAt:=xlWhole)
If Found Is Nothing Then
lastRowWks2 = Wks2.Cells(Rows.Count, "B").End(xlUp).Row
.Rows(c.Row).Copy Destination:=Wks2.Rows(lastRowWks2 + 1)
End If
End If
Next
End With
'----------------------------------------------------------------------------------------------- _
'Vorhandene  Datensätze in t_Report überschreiben, da Änderung in den "Daten"stattgefunden hat
' z. b. hier noch offene Tickets wurden zwischenzeitlich geschlossen
With Wks1
lastRowWks1 = Wks1.Cells(Rows.Count, "G").End(xlUp).Row
lastRowWks2 = Wks2.Cells(Rows.Count, "G").End(xlUp).Row
For i = 2 To lastRowWks1
For j = 7 To 15
If .Cells(i, 7).Value  Wks2.Cells(i, 7) Then
.Cells(i, j).Copy Destination:=Wks2.Cells(i, j)
End If
Next j
Next i
End With
'----------------------------------------------------------------------------------------------- _
Wks2.Activate
'Tabellengröße anpassen in t_Report
Dim lastRowNew As Long
lastRowNew = Wks2.Cells(Rows.Count, "B").End(xlUp).Row
Wks2.ListObjects("t_DatenGradient").Resize Range("$A$1:$O" & lastRowNew)
With Wks2
For lgCount = lastRowWks2 To 2 Step -1
If IsEmpty(Cells(lgCount, 2)) Then
Cells(lgCount, 2).Delete shift:=xlUp
End If
Next
End With
'----------------------------------------------------------------------------------------------- _
'Sortieren
ActiveWorkbook.Worksheets("t_Report").ListObjects("t_DatenGradient").sort. _
SortFields.Clear
ActiveWorkbook.Worksheets("t_Report").ListObjects("t_DatenGradient").sort. _
SortFields.Add Key:=Range( _
"t_DatenGradient[[#All],[Datum der Störungsmeldung]]"), SortOn:= _
xlSortOnValues, Order:=xlAscending, DataOption:=xlSortTextAsNumbers
With ActiveWorkbook.Worksheets("t_Report").ListObjects("t_DatenGradient").sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Application.CutCopyMode = False:
Application.ScreenUpdating = True
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
''Das Blatt Daten löschen
Application.DisplayAlerts = False
Wks1.Delete
Application.DisplayAlerts = True
ThisWorkbook.Worksheets("Arbeitsanleitung").Activate
End Sub