Forumbeitrag
Excel-Version des Fragestellers:
365 privat
Erfahrungslevel des Fragestellers:
Kaum Excel/VBA-Kenntnisse
https://www.herber.de/bbs/user/180733.xlsm
Habe an der Tabelle zur Erfassung von meinen Arbeitszeiten jetzt noch ein Problem, dass ich nicht gelöst bekomme. Ich habe von B7-B37 identische Dropdownlisten, in denen ich Abwesenheitsgründe auswählen kann. Jetzt möchte ich z.B. bei 3 Wochen Urlaub nicht jede Dropdownliste einzeln auf Urlaub stellen müssen, sondern, wie ja in Excel möglich, einfach den Wert in der ersten Liste auswählen und dann durch ziehen des Fill-Punktes, die unteren Listen mit auswählen, die dann automatisch den Wert der ersten Liste bekommen.
Leider sind die Wochenenden schreibgeschützt, sobald ich beim Ziehen über einen Samstag, oder Sonntag komme, wird die Aktion von Excel mit einem Warnhinweis (Schreibschutz) abgebrochen und keine der Listen erhält den neuen Wert. Ich benötige also einen VBA Code, der die schreibgeschützten Listen beim Ziehen erkennt und diese ignoriert. Da ich selber von VBA keine Ahnung habe, habe ich mal die KI befragt, die mir zwar immer wieder bestätigt, dass das mit VBA möglich wäre, aber leider hat keiner der Codes, die sie mir gegeben hat, funktioniert. Hier mal ein Beispiel, dass ich auch in der Beispiel-Datei eingefügt habe:
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Dim rngSel As Range
Dim c As Range
Dim newValue As Variant
Dim ws As Worksheet
Dim col As Long
' Nur, wenn die Änderung in Spalte B erfolgt
col = 2 ' Spalte B
If Intersect(Target, Me.Columns(col)) Is Nothing Then Exit Sub
Application.EnableEvents = False
On Error GoTo Cleanup
newValue = Target.Value
' Bereich der Dropdown-Liste (anpassen, hier B7:B37)
Set rngSel = Me.Range("B7:B37")
For Each c In rngSel
If Not Intersect(c, Target) Is Nothing Then
' Überspringe schreibgeschützte Zellen
If Not c.Locked Then
c.Value = newValue
End If
End If
Next
Cleanup: Application.EnableEvents = True
End Sub
Es funktioniert leider auch nicht erkennt ihr hier Fehler?