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
|