Guten Abend beisammen,

der oben genannte code funktioniert tadellos. Mir ist aber eine "Unschönheit" aufgefallen:

der Bereich für die ID's welche in Abdeckung definiert habe ist fix von A28:A200. Das Problem besteht darin, dass bei Drücken auf ein leere Zelle in diesem Bereich eine neu Tab erstellt wird welche keine Nummer enthält. Dies führt dazu, dass ich jedes mal wenn ich eine neue ID-nummer in eine leere Zelle schreiben möchte ein neues sheet aufgemacht wird. Ich möchte aber ausschließlich nur gefüllte zellen beim Drücken aufmachen. D.h. bei einer leeren Zelle sollte ohneeine neue Tab zu erstellen eine ID-Nummer eintragen können. Nur ausgefüllte Zellen sollten ein neues sheet aufmachen.

Habt ihr dies bzgl. eine Idee wie man das realisieren könnte?

folgender Code ist der Aktuellste:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim rngTreffer As Range
Set rngTreffer = [A28:A200]
If Not Intersect(Target, rngTreffer) Is Nothing Then
    Call Makro5(Target)  'Treffer aus Bereich u. selektierte Zelle wird als Target übergeben
End If
Set rngTreffer = Nothing
End Sub

UND

Sub Makro5(Rng As Range) 'Target wird in Makro5 Funktion als Rng Argument übernommen

Dim Zelle As Range, Wsh As Excel.Worksheet, flag As Boolean 'flag ist eine Flankenvariable
    
On Error GoTo errh
 
'Sheets("Abdeckung").Select
   'aktive Zelle = Target - übergeben als Rng
   Set Zelle = Rng
   'prüfe auf vorhanden
   For Each Wsh In ThisWorkbook.Sheets
      '"Test ID" & Zelle.Formula = String = Tabellenname
      If Wsh.Name = "Test ID" & Zelle.Formula Then
         'Treffer = Worksheet.Object = zugewiesen
         flag = True
         Exit For
      End If
   Next Wsh
    
   Application.ScreenUpdating = False
    
   If Not flag = True Then
      'kein Treffer
      Sheets("Muster").Copy After:=Sheets(Sheets.Count)
       
      'kopierte Tabelle "Muster" zu Worksheet.Object
      'Set Wsh = ThisWorkbook.Sheets(Sheets.Count)
      
      Set Wsh = ThisWorkbook.Sheets("Muster (2)")
       
       
      'Worksheet.Object - Eigenschaften einrichten
      With Wsh
         .Name = "Test ID" & Zelle.Formula
         .Visible = xlSheetVisible
         .Range("B2").Font.Bold = True
      End With
       
      'Zelle = Range.Object in die Zwischenablage
      Zelle.Copy
       
      'Worksheet.Object - einfügen
      Wsh.Range("B2").PasteSpecial xlPasteValues
      Application.CutCopyMode = False
       
   End If
    
   'Worksheet.Object zeigen
   Wsh.Activate
 
errh:
Application.ScreenUpdating = True

End Sub

Für jede Vorschlag bin ich euch sehr dankebar..

Viele Grüße

Sammy