ich hab mal versucht ein paar Sachen zu vereinfachen bzw. zusammenzufassen. die Fehlererkennung läuft teilweise über den Inhalt des Fehlertextes. Ein paar Variablen habe ich rausgehauen.

Option Explicit
'Das Programm wurde von einem Forenmitglied im VBA-Forum.de überarbeitet und lauffähig gemacht! Vielen Dank!

Sub AutoRange_Export()        'Das Modul_AutoRng muss auf dem ersten Feldnamen (hier Standort) _
'                                 gestartet werden. Der nach der Vorlage (siehe Blatt ANLEITUNG) _
'                                 erkannte Zellbereich wird als Bereich erkannt und in eine _
'                                 Semikolongetrennte *.CSV-Datei gespeichert
                                     
    Dim ws As Worksheet
    Dim wb As Workbook
    Dim WorkRng As Range            'für Zellbereich aus Kopfzeilen + Datenzellen
   
    Dim CSVName As String           'Ist die letzte Spalte eine Kopfzelle
    Dim strErr As String
    Dim lngDauer As Variant         'Ist die letzte zeile eine Datenzelle (Inhalt vorhanden)
    Dim AzBuecher&
    Dim NameAnhang As String
    
                                    ' +++ Defaultwerte
    CSVName = "CSV-Transfer"        ' Dateiname für CSV-Datei
    lngDauer = 3                    ' MsgBox Anzeigedauer in Sekunden
   'FlagExt = ""                    ' Defaultwert >=1 wird ausgewertet
       
    Set WorkRng = ActiveCell
    
    Call auto_range(strErr, WorkRng, AzBuecher, NameAnhang)  'gültiger Zellbereich ermitteln
                                                            
    If strErr <> "" Then GoTo Fehler
    
    '*** neues Workbook erstellen
    Set wb = Workbooks.Add
    wb.Worksheets(1).Name = WorkRng.Worksheet.Name
    
    'Datenbereich kopieren
    WorkRng.Copy Destination:=wb.Worksheets(1).Range("A1")
    
    Application.DisplayAlerts = False    'WarnMeldung wenn überschreiben ? AUS
    
    On Error GoTo Fehler                 'nach CSVName kann noch & WorkRng.Worksheet.Name
    'Speichert im Pfad der Exceldatei
    wb.SaveAs Filename:=ThisWorkbook.Path & "\" & CSVName & NameAnhang, _
                                      FileFormat:=xlCSV, _
                                      CreateBackup:=False, _
                                      Local:=True
    wb.Close True
    Application.DisplayAlerts = True      'WarnMeldung überschreiben ? Ein
        
    Call MessageBox_zeitgesteuert(CSVName, NameAnhang, lngDauer, AzBuecher)
    
    Exit Sub
Fehler:
     If strErr = "" Then strErr = "Fehler beim Speichern"
     MsgBox "Keine Datei erstellt." & vbLf & strErr, vbCritical, "ein Fehler ist aufgetreten"

End Sub

Sub auto_range(sErr As String, WorkRng As Range, lngAzB As Long, NameAnhang As String)
   'Datensatz auf Gültigkeit prüfen
    
    Dim i&, LastRow&, FirstRow&
    Dim VorlFeldnamen As Variant
    
    'Vorlagen Feldnamen in Datenfeld speichern
    VorlFeldnamen = Application.Transpose( _
                    Application.Transpose(Range(Range("Kopfz_S"), Range("Kopfz_6").End(xlToLeft))))
           
'***************** Prüfen ob Starzelle  = 1. Kopfzelle
    sErr = ""
    If WorkRng <> VorlFeldnamen(1) Then
        sErr = " Bitte den ersten Feldnamen  " & Range("Kopfz_S").Value & "  wählen! "
        Exit Sub
    End If
     
'***************** Prüfen ob die Kopfzeile der Vorgabe aus "Anleitung" entspricht *************
   
   For i = LBound(VorlFeldnamen) To UBound(VorlFeldnamen)
    If WorkRng.Offset(, -1 + i).Value <> VorlFeldnamen(i) Or WorkRng.Offset(, -1 + i).Value = "" Then
        Exit For
    End If
   Next
    
    'nach fehlerfreiem For-Schleifendurchlauf ist i > Ubound(vorlfeldnamen)
    If i <= UBound(VorlFeldnamen) Then
      sErr = "Feldnamen stimmen nicht überein - Siehe Blatt Anleitung!!"
      Exit Sub
    End If
'************************************************************************************************
   
'############################## String  löschen bis - #####################################
     
  'Anzahl Bücher = Anzahl der Zeilen unterhalb Überschrift
  lngAzB = WorkRng.End(xlDown).Row - WorkRng.Row
  
  'Prüfung Überschreitung MaxBücheranzahl
    If lngAzB > Range("MaxBuecher").Value Then
       sErr = lngAzB & " Bücher sind zu viel." & vbLf & _
              "Es sind nur " & Range("MaxBuecher").Value & " im Fach vorgesehen"
      
    Else
        'Namens Erweiterung
        NameAnhang = IIf(Range("okExtension").Value >= 1, "_ab_" + WorkRng.Offset(1, 0).Value, "")
        NameAnhang = NameAnhang & "_bis_" + WorkRng.Offset(lngAzB)
        'Ändert die Größe des angegebenen Bereichs
        Set WorkRng = WorkRng.Resize(lngAzB + 1, UBound(VorlFeldnamen))
    End If
      
End Sub

Private Sub MessageBox_zeitgesteuert(CSVName, NameAnhang, lngDauer, AzBuecher)
                                                            'Beendet die Windows "MessageBox" nach lngDauer
Dim iAnzeige As Integer
Dim objShell As Object
Set objShell = CreateObject("WScript.Shell")
iAnzeige = objShell.Popup("In der neuen Datei  " & CSVName & NameAnhang & ".CSV  wurden " & _
                            AzBuecher & " Bücher gespeichert", _
                            lngDauer, _
                            "CSV für BOOKcook Import Anzeigedauer: " & lngDauer & " sec.", _
                            vbInformation)
End Sub