Office: (Office 2007) Neue Zeile Makro spinnt in einer Spalte

Hi ihr Lieben,

ich habe ein etwas konfuses Problem. Ich habe folgendes Makro:

Code:

Sub Zelle_einfügen_Kategorien()
   
 With Rows(ActiveCell.Row)
     .Copy
     .Insert shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
     .SpecialCells(xlCellTypeConstants).ClearContents
 End With
 Application.CutCopyMode = False
 End Sub

Dieses funktioniert soweit, wie es soll. Ich füge eine neue Zeile ein und vorhandene Formatierungen und Formeln werden übernommen. Nun passiert das verrückte. In Zeile B und C klappt das nicht (beide zusammengefügt., da bleibt dann ein Hänger und 2 Zeilen sind in diesen 2 Spalten identisch. Ich habe viele verschiedene Formeln ausprobiert und nichts hat wirklich geholfen. Da verrückteste war, als ich zum Test eine andere Formel aus anderen Spalten (da habe ich 3 zusammengefügt und es klappt alles), reinkopiert habe, funktionierte es auf einmal. Also habe ich ähnliches zur Problemlösung probiert, aber das hat nicht geholfen. Verwirrend, oder? Deswegen habe ich mal eine ähnliche Tabelle mit angehangen. (Da ist noch ein Makro, wenn ihr in Zeile E den Wert löscht und dann was eintragt, erscheint Datum und Benutzername, nicht wundern)

Den Anhang Beispiel Makro Zeile einfuegen.xlsm betrachten

VG
Tobi

 

PS:

Ich bin gerade dabei noch ein anderes Makro umzuschreiben. Da funktioniert es mit den Formeln, nur löscht es zur Zeit die Zeile darunter, statt die neue einzufügen. Vielleicht ist dieses Makro aber besser:

Code:

Sub NeueZeile()
 Dim Zeile As Long

 With ActiveSheet
    'Zeilennummer:
    Zeile = ActiveCell.Row + 1
    'Kopieren:
    Intersect(.Rows(Zeile - 1), .UsedRange).Copy
    .Cells(Zeile, 1).PasteSpecial Paste:=xlPasteFormats            'Formate
    .Cells(Zeile, 1).PasteSpecial Paste:=xlPasteFormulas           'Formeln
    Application.CutCopyMode = False
     
    'Werte löschen
    Intersect(.Rows(Zeile), .UsedRange).SpecialCells(xlCellTypeConstants).ClearContents
     
 End With
 End Sub

 

Hier des Rätsels Lösung, falls eine*r von euch mal ein ähnliches Problem hat:

Code:

Sub Zelle_einfügen_Kategorien()
   
 With Rows(ActiveCell.Row)
     .Copy
     .Insert shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
     .SpecialCells(xlCellTypeConstants).ClearContents
 End With
 Application.CutCopyMode = False
 

Dim Ende As Long

    With ActiveSheet
         Ende = .Cells(.Rows.Count, 2).End(xlUp).Row
         .Range("B8:C8").AutoFill Destination:=Range("B8:C" & Ende), Type:=xlFillDefault
    End With
End Sub