Formatvorlagen löschen langsam

Sub Speed_on()
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.DisplayAlerts = False
Application.Calculation = xlManual
End Sub

Sub Speed_off()
Application.ScreenUpdating = True
Application.EnableEvents = True
Application.DisplayAlerts = True
Application.Calculation = xlAutomatic
End Sub

Sub Delete_Formatvorlagen_benutzerdefinierteDirektFast()
Dim objStyle As Style, icount As Long, bolDelete As Boolean
Dim wbk As Workbook, wbkNeu As Workbook
Dim arrStyles() As String
Set wbk = ActiveWorkbook
On Error Resume Next
Speed_on
'Standardliste von Styles ermitteln in leerer neuer Arbeitsmappe
Set wbkNeu = Application.Workbooks.Add(Template:=xlWBATWorksheet)
For Each objStyle In wbkNeu.Styles
icount = icount + 1
ReDim Preserve arrStyles(1 To icount)
arrStyles(icount) = objStyle.Name
Next
wbkNeu.Close savechanges:=False
'Namen der Styles/Formatvorlagen in der aktiven Arbeitsmappe mit den Standard-Styles _
vergleichen und benutzerdefinierte löschen
For Each objStyle In wbk.Styles
bolDelete = True
For icount = 1 To UBound(arrStyles)
If arrStyles(icount) = objStyle.Name Then bolDelete = False: Exit For
Next
If bolDelete = True Then
objStyle.Delete
End If
Next
Speed_off
End Sub