Hallo,
na das ist doch schon mal was. Jetzt müssen wir nur noch die Range- Zugriffe minimieren. Jede Zeile wird einmal gelesen und einmal geschrieben. Wenn wir die Schreibzeit einsparen, sollte sich das nochmal verbessern. Probier mal, ob das hier was bringt.
Sub KopierenUndWerteEinfügen()
Dim lngLetzte As Long
Dim Bereich As Variant
Dim arr(), arrzei()
Application.ScreenUpdating = False
lngLetzte = ActiveSheet.Cells(Rows.Count, 2).End(xlUp).Row - 4
ReDim arr(1 To lngLetzte, 1 To 21)
For i = 1 To lngLetzte
Range(Cells(4, 30), Cells(4, 50)).Copy Cells(4 + i, 30) ' Für Formate einfügen
arrzei = Range(Cells(4 + i, 30), Cells(4 + i, 50))
Range(Cells(4 + i, 30), Cells(4 + i, 50)).ClearContents
For k = 1 To 21
arr(i, k) = arrzei(k - 1)
Next k
Next i
Cells(4 + 1, 30).Resize(lngLetzte, 21).Value = arr
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Application.Calculate
End Sub
Um noch weitere Einsparungen zu treffen musst du wie gesagt die Formelberechnungen direkt in VBA durchführen. und somit das Copy Paste der Formeln einsparen. Da ich deine Formeln nicht kenne kann ich dir hier aktuell leider nicht weiterhelfen. Aber du kannst hier gern eine Datei mit Beispieldaten hochladen, dann schau ich mir das mal an.
Gruß Mr. K.