Zelle nach Eingabe sperren, andre datei hochzählen
Reinhard
Hi Shaaree,
das ist ja schon Auftragsprogrammierung, ich ziehe mich mal langsam zurück.
diesen Code:
Sub Einmalig()
With Worksheets("Tabelle1")
.Cells.Locked = False
.Protect ("Shaaree")
End With
End Sub
ein einziges Mal laufen lassen. Dann ist die tabelle mit Passwort Sharee" geschützt aber in alle Zellen kann geschrieben werden.
Nachfolgenden Code dann in den Codeteil der Tabelle1 kopieren.
Gruß
Reinhard
Private Sub Worksheet_Change(ByVal Target As Range)
' nur reagieren wenn Spalte=10=J und nur eine zelle gewählt in J
If Target.Column <> 10 Or Target.Cells.Count > 1 Then Exit Sub
If Range("J" & Target.Row).Value = "erledigt" Then
Range("H" & Target.Row).Value = Now
Worksheets("Tabelle1").Unprotect ("Shaaree")
With Range("J" & Target.Row).Validation
.Delete
.Add Type:=xlValidateInputOnly, AlertStyle:=xlValidAlertStop, Operator:=xlBetween
.IgnoreBlank = True
.InCellDropdown = True
.ShowInput = True
.ShowError = True
End With
Range("H" & Target.Row).Locked = True
Range("J" & Target.Row).Locked = True
Worksheets("Tabelle1").Protect ("Shaaree")
Datei = MonthName(Month(Range("H" & Target.Row).Value)) & ".xls"
'Datei = ThisWorkbook.Path & "\" & Datei
For Each wb In Workbooks.Count
If wb.Name = Datei Then vorh = True
Next wb
If vorh = False Then Workbooks.Open Datei
With Workbooks(Datei)
If .ReadOnly = True Then
MsgBox "Datei " & Datei & " ist schreibgeschützt, kann nichts eintragen"
Else
.Worksheets("Tabelle1").Range("A1") = .Worksheets("Tabelle1").Range("A1") + 1
.Close SaveChanges:=True
End If
End With
End If
End Sub