Hallo Alfonso,
In der "Musterzeile", die Zelle in Spalte A Sperren und die Muster- Zeile mit einer Hintergrundfarbe versehen, das sollte das unbeabsichtigte Einfügen in der Musterzeile verhindern.
Die zusätzliche Makrozeile einfügen, sie entfernt wieder den kopierten Zell- Schutz, in der eingefügten Zeile in der Spalte A.
Die Zelle in Spalte A der Musterzeile wird auch noch überprüft, ob sie Leer ist, dann wird das Makro ausgeführt.
das geänderte Makro:
****************************************************************************************
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 Letzte Muster - Datenzeile in Spalte ? (5)
' "Spaltenangabe Bitte Anpassen"
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.
' ********************* ÄNDERN ************************
If Range("A" & (MaxDatenZeile)) > "" And Range("A" & (MaxDatenZeile) + 1) = "" Then
' ********************* ÄNDERN ************************
' Blattschutz entfernen "passwort" bitte anpassen innerhalb " ".
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
' ****************** EINFÜGEN *********************
' Zelle in Spalte A der neuen Eingabezeile Freigeben
Range("A" & (MaxDatenZeile)).Locked = False
' ****************** EINFÜGEN *********************
' nächste Eingabezelle Aktivieren nach Zeile Kopieren,
' Spalte Bitte anpassen .......Range("B" ........,
' die Zelle darf nicht geschützt sein.
Range("B" & (MaxDatenZeile) - 1).Select
' Blattschutz setzen "passwort" bitte anpassen innerhalb " ".
On Error Resume Next
ActiveSheet.Protect "passwort", DrawingObjects:=True, Contents:=True, Scenarios:=True
' ****************** EINFÜGEN *********************
Else
' ****************** EINFÜGEN *********************
End If
End Sub
hddiesel
