Hallo Alfonso,
Musterzeile geschützt, in der neuen Eingabezeile,
den Zellschutz in der Spalte A, B, D wieder entfernt.
Kannst das Makro auch auf deine Bedürfnisse anpassen,
deshalb die vielen REM - Zeilen mit Kommentar im Makro.
Einfach mal testen.
****************************************************************
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim MaxDatenZeile As Integer
Dim SuchSpalte As Integer
' Die Tabelle sollte in den 2 Letzten Zeilen nur Formeln und gewünschte Rahmen haben.
' Die letzte Zeile dient als Musterzeile mit Formeln und wird vom Makro Kopiert!
' Letzte Muster - Zeile mit Formeln bitte färben,
' um aus versehen keine Einträge vorzunehmen,
' ebenso mit den gewünschten Rahmen versehen,
' Garantierter Formel - Eintrag in der Muster - Datenzeile in Spalte ? (5)
' "Spaltenangabe Bitte anpassen", denn diese Zelle darf nicht leer sein.
SuchSpalte = 5
' Muster - Datenzeile ermitteln.
MaxDatenZeile = ActiveSheet.Cells(Rows.Count, (SuchSpalte)).End(xlUp).Row
' (Minus 1 ist Letzte Leere Dateneingabezeile)
MaxDatenZeile = MaxDatenZeile - 1
' Wenn in Spalte A der letzten Eingabezeile (Zeile oberhalb der Musterzeile),
' ein Eintrag vorgenommen wird, wird die Musterzeile Kopiert,
' so daß wieder eine Eingabezeile zur Verfügung steht.
If Range("A" & (MaxDatenZeile)) > "" And Range("A" & (MaxDatenZeile) + 1) = "" Then
' Blattschutz entfernen
On Error Resume Next
ActiveSheet.Unprotect "passwort"
' Then von oben ausführen
MaxDatenZeile = MaxDatenZeile + 1
' Letzte Leere Dateneingabezeile mit Formatierung Auswählen und Kopieren
Rows((MaxDatenZeile) & ":" & (MaxDatenZeile)).Select
Selection.Copy
' Fügt die Kopierte Zeile in das Arbeitsblatt ein und verschiebt die Musterzeile nach unten,
' so paßen sich die Formel Automatisch an.
Selection.Insert Shift:=xlDown
' Rahmen von Kopiemarkierung löschen
Application.CutCopyMode = False
' Eingabe- Zeile Entfärben
Selection.Interior.ColorIndex = xlNone
' Zelle in Spalte A, B, D, der neuen Eingabezeile den Zellschutz entfernen
Range("A" & (MaxDatenZeile)).Locked = False
Range("B" & (MaxDatenZeile)).Locked = False
Range("D" & (MaxDatenZeile)).Locked = False
' Eingabezelle nach dem Zeilen Kopieren Aktivieren
Range("B" & (MaxDatenZeile) - 1).Select
' Blattschutz setzen
On Error Resume Next
ActiveSheet.Protect "passwort", DrawingObjects:=True, Contents:=True, Scenarios:=True
Else
End If
End Sub
Fetzo1
