viel zu langsamer Code!

Private Sub Worksheet_Activate()
Application.ScreenUpdating = False
If Range("f91, c107").Value = 0 Then
Dim Zelle, Nd, NdArt, Rt As Range
Set Nd = Range("b6:b89")
Set NdArt = Range("c6:c89")
Set Rt = Range("d6:d89")
Range("b111").Copy
Nd.PasteSpecial Paste:=xlFormulas
Range("c111").Copy
NdArt.PasteSpecial Paste:=xlFormulas
Range("d111").Copy
Rt.PasteSpecial Paste:=xlFormulas
Calculate
For Each Zelle In Nd
Zelle.Value = Zelle.Value
Next
For Each Zelle In NdArt
Zelle.Value = Zelle.Value
Next
For Each Zelle In Rt
Zelle.Value = Zelle.Value
Next
Exit Sub
End If
Application.ScreenUpdating = True
End Sub