Format und Formeln von letzter Zeile übernehmen
21.09.2023 13:57:52
frank porschatis
Ich möchte eine dynamische Tabelle erstellen und wegen der Übersichtlichkeit immer eine Leerzeile mit einfügen.
Ausgangspunkt - Zeile 1 ist mit Werten gefüllt - Spalte A soll mit laufender Nummerierung immer gefüllt sein.
Das Makro macht folgendes - Es wird geschaut, wo ist in Spalte A die letzte gefüllte Zelle ( Beispiel in A1 steht die Ziffer 1).
Bei Eintrag in A2 (mit Ziffer 2) wird eine Leerzeile generiert und der neuer Zeichensatz steht eine Zeile darunter in A3.
Die Formatierungen und Formeln sollen von der letzten gefüllten Zeile mitgenommen werden.
Problem - der Wert in Spalte A wird überschrieben. heißt in Zelle A3 steht nicht 2 sondern wieder die 1??
Wie kann man Spalte A vorm überschreiben ausnehmen. Rows(sz+1).copy.PasteSpecial... verursacht diesen Fehler, oder?
Ich hoffe ich habe mich nicht zu kompliziert ausgedrückt. Oder geht das einfacher.
Danke schon mal fürs drüberlesen.
Gruß Frank
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim sz As Long, ls As Long, nZelle
sz = Target.Row
ls = ActiveSheet.Cells(sz, Columns.Count).End(xlToLeft).Column
If Target.Column = 1 And Target.Count = 1 Then
Application.EnableEvents = False
Rows(sz).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Rows(sz - 1).Copy
Rows(sz+1).PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Rows(sz+1).PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
For Each nZelle In ActiveSheet.Range(Cells(sz, 1), Cells(sz, ls))
If Not nZelle.HasFormula Then
nZelle.ClearContents
End If
Next nZelle
Application.EnableEvents = True
End If
End Sub
Anzeige