"Replace" Makro dauert 2-3 Minuten

Sub Ersetzen()
Dim Zähler As Integer
Dim Zelle As Range
Dim Spalte As Integer
Zähler = 1
Spalte = 1
Application.ScreenUpdating = False
Do Until ActiveSheet.Cells(Zähler, 1).Value = ""
For Spalte = 1 To 3
For Each Zelle In ActiveSheet.Cells(Zähler, Spalte)
Zelle.Value = Replace(Zelle.Value, "Sonstiges: ", "")
Zelle.Value = Replace(Zelle.Value, "Datum: ", "")
Next Zelle
Next
Zähler = Zähler + 1
Loop
Application.ScreenUpdating = True
End Sub