Makro Absturz beim zweiten Ausführen

Hallo, ich bin noch relativ neu in der VBA Programmierung, darum bitte ich um Nachsicht.

Hier das Problem: Ich habe eine Liste, aus welche Daten für ein Protokoll in einem seperaten Tabellenblatt gezogen werden. Dieses Protokoll soll in ein separates Dokument kopiert werden, allerdings nur mit den statischen Werten (damit keine Bezüge mehr vorhanden sind).
Der Code funktioniert beim ersten Mal ausführen einwandfrei, allerdings stürzt Excel beim zweiten Mal ausführen ab. Wird der Code über Einzelschritte durchgeführt funktioniert es ebenfalls ohne Fehler.
Ich bin inzwischen etwas ratlos. Habe schon recht viel recherchiert, bin aber leider noch nicht fündig geworden.

Hier der Code:

Option Explicit

Sub Prot_kopieren_statisch()
'
' BlattKopieren in eine ausgewählte Datei Makro

Dim Dateiname As Variant
Dim wbZiel As Workbook
Dim wbQuelle As Workbook
Dim wsKopiert As Worksheet  'das kopierte Protokoll
Dim wsQuelle As Worksheet
Dim ws As Worksheet
Dim btn As Button
Dim BPNr As String



Set wbQuelle = ThisWorkbook 'Workbook Quelle ist diese Arbeitsmappe
Set wsQuelle = wbQuelle.Worksheets("Protokoll_Übertrag")
BPNr = wsQuelle.Range("E9")

'ScreenUpdating und PopUps deaktivieren
Application.ScreenUpdating = False
Application.DisplayAlerts = False 'Meldungen zu großer Datenmenge werden unterdrückt



'Benutzer kann Datei auswählen xlsm oder xlsx
Dateiname = Application.GetOpenFilename(FileFilter:="Excel-Dateien (*.xls*),(*.xls*")

'Wurde eine Datei ausgewählt?
If Dateiname > False Then
    
    
    'Arbeitsmappe öffnen
    Set wbZiel = Workbooks.Open(Filename:=Dateiname)
'        DoEvents
    'Prüfen ob Protokoll schon existiert
    Dim BoVorhanden As Boolean
    For Each ws In Worksheets

    If ws.Name = BPNr Then
    BoVorhanden = True
    Exit For
    End If
    Next ws
    If BoVorhanden Then
        MsgBox ("Das zu kopierende Protokoll ist schon vorhanden. Bitte kontrollieren und zuerst löschen")
'   Arbeitsmappe schließen
        wbZiel.Close SaveChanges:=False
    Else
        
        
        'Tabellenblatt kopieren und einfügen

        wsQuelle.Copy After:=wbZiel.Sheets(wbZiel.Sheets.Count) 'am Ende einfügen
        
        'Buttons in kopiertem Blatt löschen
        Set wsKopiert = wbZiel.ActiveSheet
        wsKopiert.Buttons.Delete
    
        
        'Daten kopieren und nur Inhalt ohne Formeln (Bezüge) einfügen
        wsKopiert.Range("A1:AE51").Copy
        wsKopiert.Range("A1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
        
        ' Blatt umbenennen
        wsKopiert.Name = wbZiel.Sheets(Sheets.Count).Range("E9")
        
        'Arbeitsmappe schließen
        wbZiel.Close SaveChanges:=True
        
        'Feedback für Benutzer
        MsgBox ("Protokoll für den Pfahl " & BPNr & " wurde erfolgreich übertragen")

    End If
End If

'ScreenUpdating und PopUps aktivieren
Application.ScreenUpdating = True
Application.DisplayAlerts = True


End Sub