Hallo Alfonso,
hast du "SuchSpalte = 5" angepaßt auf eine Formel in der Musterzeile?
Laut deiner Beschreibung wurde die Zeile nicht angepasst und weist auf eine leere Zelle in der Musterzeile
Am Ende deiner Tabelle, müssen 2 Leere Zeilen (nur mit Formeln) sein,
die Letzte Zeile als Muster, die vorletzte Zeile als Eingabezeile,
wenn in der letzten Eingabezeile vor der Musterzeile die Zelle in Spalte A beschrieben wird,
wird die Musterzeile kopiert.
Makro mit Blattschutz!
**********************************************************************
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.
If Range("A" & (MaxDatenZeile)) > "" Then
' 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
' 1. Eingabezelle Aktivieren
Range("B" & (MaxDatenZeile) - 1).Select
' Blattschutz setzen "passwort" bitte anpassen innerhalb " ".
On Error Resume Next
ActiveSheet.Protect "passwort", DrawingObjects:=True, Contents:=True, Scenarios:=True
End If
End Sub
hddiesel
