Hallo zusammen,

ich habe zusammen mit euere Hilfe ein macro erstellt, welches beim Dücken einer ID nummer im Sheet Abdeckung ein neues Sheet erstellt wird, bei dem die ID nummer übertragen wird, der Tabellenname mit der ID nummer benannt wird und die id nummer in eine Zelle im neuen Sheet reinkopiert wird. Nun habe ich noch eine Unschönheit die ich beseitigen möchte:
im der Abdeckungs Tabelle (die Hauptübersicht), möchte ich nur ein neues sheet erstellen wenn in der ID spalte bereits eine Nummer eingetragen ist. Im Moment funktioniert alles tadellos, aber wenn ich eine neue id einfügen möchte wird sofort eine neue Tabelle erstellt ohne id nummer ich muss dann zurückkehren zur übersicht, um nochmal eine id eingeben zu können.

Könnte man diese Unschönheit nicht beseitigen, indem man nur bei ausgefüllter Zelle bei den ID's ein neues tab erstellt wird und alles was leer ist wird ignoriert?

untenstehend der Code des Macro's

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




Ich bin kein Excel-Experte daher würde ich mich über jeden Vorschlag freuen.

Danke und Grüße
Sammy