Hallo,

jetzt hab ich doch noch eine Frage.

In einer csv speichere ich für einen Datensatz Kopfzellen und Datenzellen.
Die erste Kopfzelle prüfe ich, aber wie prüfe ich ob dies nicht die einzige ausgewählte Zelle ist.

Danke für Eure Hilfe
Ulli 

Option Explicit
                                ' Projekt Buecherlisten per ISBN-Scan´s erstellen für BOOKcook- Import
Sub RangetoCSV_Export()         ' Speichert markierte Zellbereiche in eine Semikolongetrennte *.CSV-Datei
                                
Dim Rng As Range
Dim WorkRng As Range            'für markierten Zellbereich aus Kopfzeilen + Datenzellen
Dim xFile As Variant
Dim zelle As Variant
Dim ZelleAnfang As Variant
Dim ZelleEnde   As Variant
Dim CSVName As String
Dim lngDauer As Long
Dim ErsteZelleValue As String
ErsteZelleValue = "Standort"    ' Inhalt der ersten Zelle der Kopfzeile
CSVName = "CSV-Transfer"        ' Dateineme für CSV-Datei
lngDauer = 2                    ' Dauer der Anzeige CSVNAme gespeichert

On Error Resume Next
Set WorkRng = Application.Selection

Range(WorkRng).Select

If ActiveCell.Value <> ErsteZelleValue Then 'Prüfen ob 1. Zelle der Kopfzeile stimmt
  MsgBox "!! Die erste Zelle muss  """ & ErsteZelleValue & """  sein !!", vbCritical
  GoTo Fehler
End If

'*************************** Prüfen ob nur eine Zelle ausgewählt ist, wenn ja Fehler

'If                          =               Then
'  MsgBox "!! Bitte einen Bereich auswählen !!", vbCritical
'  GoTo Fehler
'
'End If


'**************************

Application.ActiveSheet.Copy        'Kopiert in neues Workbook unter "Mappe_n)
Application.ActiveSheet.Cells.Clear 'löscht alle Zellen in neuer Mappe_n
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)
Fehler:
End Sub


Sub MessageBox_zeitgesteuert(CSVName, lngDauer)
Dim iAnzeige As Integer
Dim objShell As Object
Set objShell = CreateObject("WScript.Shell")
iAnzeige = objShell.Popup("Die neue Datei  " & CSVName & ".CSV  wurde gespeichert", _
  lngDauer, "CSV für BOOKcook Import                                    Anzeige: " & lngDauer & " sec.", vbInformation)
        
End Sub