Wie kann ich eine  .xlsm  einstellen. Nur mit dem Modul ist der Fehler schwer zu  finden.

Das Modul funktioniert auf einem Blatt und auf anderen nicht.
Eine ältere Excelversion zeigt den Aufabau der Tabelle aber noch ohne das aktuelle Modul.

Zu finden: https://www.max-mg.de  800 Bücher...

https://www.max-mg.de

Option Explicit
                                
  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 WorkRng As Variant           ' für Zellbereich aus Kopfzeilen + Datenzellen
    Dim Worksheetx As Variant
    Dim CSVName As String           '    Ist die letzte Spalte eine Kopfzelle
    Dim lngDauer As Variant            '    Ist die letzte zeile eine Datenzelle (Inhalt vorhanden)
    Dim AzBuecher As Variant
    Dim ErsteZelleValue As String
    Dim ErrorFlag As Boolean
                                    ' +++ Defaultwerte
    CSVName = "CSV-Transfer"        ' Dateineme für CSV-Datei
    lngDauer = 1.5                  ' MsgBox Anzeigedauer in Sekunden
    
  On Error Resume Next
'    Set WorkRng = Application.Selection
'    WorkRng.Select
'    'Range(WorkRng).Select

     
    Set WorkRng = Application.Selection
    WorkRng.Select
    Range(WorkRng).Select

    'MsgBox "The name of the active sheet is " & ActiveSheet.Name

    Worksheetx = ActiveSheet.Name   'Speichern aufrufendes Arbeitsblatt
    'MsgBox "The name of the active sheet is " & ActiveSheet.Name
    Call auto_range(Worksheetx, ErsteZelleValue, ErrorFlag, WorkRng, AzBuecher) 'gültiger Zellbereich ermitteln
    If ErrorFlag = True Then GoTo Fehler
    
    '*** Zellbereich Bearbeiten
    
    Application.ActiveSheet.Copy        'Kopiert in neues Workbook unter "Mappe_n)
    Application.ActiveSheet.Cells.Clear 'löscht alle Zellen in neuer Mappe_n
    'MsgBox WorkRng.Address  '+++ zeigt Zellauswahl an +++
    
    WorkRng.Copy Application.ActiveSheet.Range("A1") 'Kopiert "Bereich/Range" ab A1 in Mappe_n
    Application.DisplayAlerts = False   'WarnMeldung wenn überschreiben ? AUS
    Application.ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\" & CSVName, FileFormat:=xlCSV, _
        CreateBackup:=False, Local:=True    'Speichert im Pfad der Exceldatei
    Application.DisplayAlerts = True    'WarnMeldung überschreiben ? Ein
    Application.ActiveWorkbook.Close True
    Call MessageBox_zeitgesteuert(CSVName, lngDauer, AzBuecher)
Fehler:
End Sub

Sub auto_range(Worksheetx, ErsteZelleValue, ErrorFlag, WorkRng, AzBuecher) 'Datensatz auf Gültigkeit prüfen
    
    Dim numCol As Variant
    Dim cntcol As Variant
    Dim LastCol As Variant
    Dim LastRow As Variant
    Dim Startzelle As Variant
    Dim Endzeile As Variant
    Dim Text As Variant
    Dim MaxBuecher As Variant
    Dim VorlFeldnamen(1 To 6) As Variant
    Dim i As Integer
    
    ErrorFlag = False          'Fehlerflag rücksetzten
       
    '******* Mu-ster Kopfzellen und Anzahl Datenzellen lesen und speichern *****
    
    Sheets("ANLEITUNG").Select
    Range("Kopfz_S").Select                 'Kopfzelle_S Startzelle

    For i = 1 To 6                           'Vorl_agen Feldnamen in Datenfeld speichern
      VorlFeldnamen(i) = Selection.Value
      ActiveCell.Offset(0, 1).Select
    Next i
     
    Range("MaxBuecher").Select
    MaxBuecher = Selection.Value           'Maximale Anzahl Datenzeilen speichern Zelle aktivieren
    
    Sheets(Worksheetx).Select              'Zurück zum aufrufenden Arbeitsblatt
        
'***************** Prüfen ob die Kopfzeile der Vorgabe aus "Anleitung" entspricht *************

    If ActiveCell.Value = VorlFeldnamen(1) Then    'Prüfen ob Wert der 1. Zelle der Kopfzelle stimmt
      Startzelle = ActiveCell.Address
    Else
      ErrorFlag = True
      GoTo FehlerZeileErsterFeldname
    End If
 '---------------
    ActiveCell.Offset(0, 1).Select             ' 2. Kopfwert

For i = 2 To 6          ' 1.Zelle wurde schon als Startzelle geprüft
    If ActiveCell.Value <> VorlFeldnamen(i) Or VorlFeldnamen(i) = "" Then
    GoTo VorlagenEnde
    ElseIf ActiveCell.Value = "" Then
      MsgBox "Feldnamen stimmen nicht überein - Siehe Blatt Anleitung!!", vbCritical
      ErrorFlag = True
      GoTo Brexit
      End If
      ActiveCell.Offset(0, 1).Select
Next i
     
VorlagenEnde:
     LastCol = i - 1                            'da LEERE Zelle erkannt, eine Spalte zurück
     ActiveCell.Offset(0, -1).Select
    
'*** Prüfen: Anzahl der Datenzellen in Spalte 1 bis LeerZelle in 1. Spalte oder Meldung wenn _
                                                                MaxBuecher erreicht
    Range(Startzelle).Select
    numCol = ActiveCell.Address
    cntcol = "1"                                'Erster Dateneintrag
    Text = ActiveCell.Value
    ActiveCell.Offset(1, 0).Select              'von Kopf- in Datenzeile 1. Spalte
       
    Do
        ActiveCell.Offset(1, 0).Select          'Suchlauf in 1. Spalte bis LEERzelle
        cntcol = cntcol + 1
    Loop While ActiveCell.Value <> ""
    
    ActiveCell.Offset(-1, 0).Select             'Korrektur auf letzten Eintrag
    LastRow = cntcol
    Endzeile = ActiveCell.Address
    
    If LastRow > MaxBuecher + 1 Then
    MsgBox cntcol - 1 & " Bücher, es sind nur " & MaxBuecher & " im Fach vorgesehen", vbExclamation
    End If
    AzBuecher = "777" 'cntcol - 1      'für MsgBox Ausgabe
Datenzellen_geprüft:

    Range(Startzelle).Resize(LastRow, LastCol).Select  'Ändert die Größe des angegebenen Bereichs
    Set WorkRng = Application.Selection
    GoTo Brexit
FehlerZeile:
    MsgBox ("Zellauswahl ungültig"), vbCritical
    ErrorFlag = True
    GoTo Brexit
FehlerZeileErsterFeldname:
    MsgBox ("Bitte ersten Feldnamen Wählen (Standort)"), vbCritical
    ErrorFlag = True
    GoTo Brexit
FehlerSpalte:
    MsgBox ("Zellauswahl ungültig, da Leerzelle in 1.Spalte oder eine weitere Kopfzelle ") & _
                                                                ("in der 1. Spalte"), vbCritical
    ErrorFlag = True
Brexit:
    Sheets(Worksheetx).Select       'Zurück zur aufrufendem Blatt
End Sub

Sub MessageBox_zeitgesteuert(CSVName, 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 & ".CSV  wurden " & AzBuecher & " Bücher gespeichert", _
  lngDauer, "CSV für BOOKcook Import                                    Anzeigedauer: " & lngDauer _
  & " sec.", vbInformation)
End Sub