Office: (Office 365) Makro dauert sehr lange

Hallo Zusammen,

unten stehendes Makro habe ich mir zusammen gebastelt.
Es soll das Blatt Br232_Sondereintragungen kopieren,die Kopie dann speichern und schließen.
Danach sollen im original Blatt Br232_Sondereintragungen alle Zellinhalte im Bereich A1:AA49 gelöscht werden.

Funktioniert auch soweit.
Leider dauert der Ablauf des Makros etwa 20 Sekunden.
Wäre da noch etwas zu optimieren ?

Code:

Sub Launch_Blatt()
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Worksheets(Array("Br232_Sondereintragungen")).Copy
ActiveWorkbook.SaveAs ("T:\HSM-MAFACT\Launch_Blätter\" & _
Format(Now, "DD_MM_YYYY_hh_MM-") & Application.Substitute(ThisWorkbook.Name, ".xlsm", "")), FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
ActiveWorkbook.Close 0
Call wegmit
ActiveWindow.ScrollRow = 2
MsgBox "Aktualisierung beendet!"
End Sub

Sub wegmit()
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Dim Bereich As Range
Dim Zelle As Range
Set Bereich = Sheets("Br232_Sondereintragungen").Range("A1:AA49")
For Each Zelle In Bereich
 If Zelle.Locked = False Or Zelle.MergeArea.Locked = False Then Zelle.MergeArea.ClearContents
Next Zelle
End Sub

 

...........Problem gelöst durch:
Application.Calculation = xlCalculationManual
code
Application.Calculation = xlCalculationAutomatic