Makro sehr langsam

Hallo, ich habe ein Excel Makro, welches sehr viele Tabellenblätter in eine neue Datei kopiert, die Werte festsetzt und das Layout übernimmt. Das Makro läuft zwar, ist aber recht langsam. Kann man es irgendwie optimieren, damit es schneller läuft?

Sub Kopieren_und_Werte_einfuegen()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.Calculation = xlCalculationManual

Dim wbSource As Workbook
Dim wbDest As Workbook
Dim ws As Worksheet

'Öffne die Quelldatei'
Set wbSource = ThisWorkbook

'Erstelle eine neue Arbeitsmappe'
Set wbDest = Workbooks.Add

'Gehe durch die Blätter und kopiere sie in die neue Arbeitsmappe'
For Each ws In wbSource.Worksheets
Select Case ws.Name
Case "Blatt1", "Blatt2", "Blatt3", "Blatt4", "Blatt5", "Blatt6", _
"Blatt7", "Blatt8", "Blatt9", "Blatt10", _
"Blatt11", "Blatt12", "Blatt13", "Blatt14", "Blatt15", _
"Blatt16", "Blatt17", "Blatt18", "Blatt19", _
"Blatt20", "Blatt21", "Blatt22", "Blatt23", "Blatt24", _
"Blatt25", "Blatt26", "Blatt27", "Blatt28", "Blatt29", "Blatt30"
ws.Copy After:=wbDest.Sheets(wbDest.Sheets.Count)
With wbDest.Sheets(wbDest.Sheets.Count)
.Cells.Copy
.Cells.PasteSpecial xlPasteValues
Application.CutCopyMode = False
.Cells(1).Select
End With
Case Else
'Überspringe Blätter, die nicht kopiert werden sollen'
End Select
Next ws

'Passe das Layout der Arbeitsmappe an'
With wbDest
.Sheets("Tabelle1").Delete
.SaveAs Filename:="Bericht 2023.xlsx", FileFormat:=xlOpenXMLWorkbook
End With

'Gebe eine Meldung aus, wenn das Makro abgeschlossen ist'
MsgBox "Das Makro wurde erfolgreich ausgeführt."

ApplicationScreenUpdating = True
Application.DisplayAlerts = True
Application.Calculation = xlCalculationAutomatic
End Sub