Hallo Alfonso,
hier einmal ein Beispielmakro, bitte mit einer Kopie deiner Tabelle testen, nicht mit dem Original.
Beschreibung im Makro!
Rechtsklick unten auf den Tabellenreiter, in welcher das Makro angewendet werden soll und Code anzeigen wählen, in die Rechte Fensterhälfte den Makrocode einfügen und Testen.
Makro wirkt nur in der eingefügten Tabelle, nicht in der ganzen Arbeitsmappe.
*****************************************************************************************
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,
' Musterzeile wird nach dem Einfügen vom Makro wieder entfärbt.
' Garantierter Formel - Eintrag in Letzte Muster - Datenzeile in Spalte ? (SuchSpalte =???)
' "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
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
' Kopierte Eingabe- Zeile, aus Musterzeile entfärben
Selection.Interior.ColorIndex = xlNone
' nach Eingabe in der Spalte A der letzten Eingabezeile, Zelle in Spalte B Aktivieren
Range("B" & (MaxDatenZeile) - 1).Select
End If
End Sub
hddiesel
