Office: Neue Zeilen einfügen mit InputBox

Hallo liebe Excel Profis,

ich möchte ein Makro erstellen, dass bei dem Klick auf einen Button eine (oder so viele wie eben gewünscht) neue Zeilen (Versionen) der Referenzzeile 7 einfügt.

Dazu sollen zwei Input Boxen erscheinen:

1. InputBox: "Wo soll die neue Zeile eingefügt werden?"
Hier möchte ich, dass automatisch die gewählte Zelle/Zeile als Position vorgeschlagen wird, man soll es aber während die InputBox geöffnet ist noch verändern können - dies funktioniert bei dem unten angefügten Makro bereits.

2. InputBox: "Wie viele neue Zeilen sollen eingefügt werden?"
Hier soll standardmäßig eine 1 eingetragen sein, die Anzahl der neu einzufügenden Zeilen soll aber beliebig festgelegt werden können.


In der Zeile 7 befindet sich meine "Referenzzeile" mit den gewünschten Formeln und Formatierungen. Jede Zeile, die mithilfe des Makros eingefügt wird, soll exakt dieser Zeile entsprechen (Formeln, Formatierung).
Ich arbeite mit bedingter Formatierung, sodass ein händisches "Leere Zeile einfügen - Zeile 7 kopieren - Inhalte Einfügen (Formeln)" vom Makro durchgeführt werden soll, um die bedingte Formatierung zu erhalten.


Ich verwende momentan folgendes Makro, das ich kopiert und etwas abgewandelt habe:

PHP:

         Sub EINFÜGEN_NEUE_ZEILE()

Dim r As Range

Set r = Application.InputBox("Bitte eine Zelle oder Zeile auswählen, " & "unterhalb der eine neue Zeile eingefügt werden soll.", "Neue Zeile einfügen unterhalb von:", Selection.Address, Type:=8)

If r.Rows.Count > 1 Then Exit Sub

r.Offset(1, 0).EntireRow.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove

Rows(r.Row).Copy

Rows(r.Row + 1).PasteSpecial Paste:=xlFormulas, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False

Application.CutCopyMode = False

On Error Resume Next
Rows(r.Row + 1).Cells.SpecialCells(xlCellTypeConstants).ClearContents

Rows(r.Row + 1).Select

End Sub


:)

 

Ich habe mir jetzt selbst folgendes Makro gebastelt, das funktioniert soweit! *Smilie

PHP:

         Sub EINFÜGEN_NEUE_ZEILEN()

Dim a As Range
Set a = Application.InputBox("Bitte eine Zelle oder Zeile auswählen, " & "oberhalb der eine neue Zeile eingefügt werden soll.", "Position für neue Zeilen auswählen", Selection.Address, Type:=8)
If a.Rows.Count > 1 Then Exit Sub

Dim b As Integer
b = Application.InputBox("Wieviele neue Zeilen sollen eingefügt werden?", _
"Anzahl der neuen Zeilen", 1, , , , , 1)

Rows(a.Row + 1 & ":" & a.Row + b).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove

Rows("7").Copy

Rows(a.Row + 1 & ":" & a.Row + b).PasteSpecial Paste:=xlFormulas, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False

Application.CutCopyMode = False

Rows(a.Row + 1 & ":" & a.Row + b).Select

End Sub


 

Moin!
Ich glaube, dass mit Deiner Methode die bedingten Formatierungen fragmentiert werden.
(Die Anzahl müsste erheblich größer werden)

Nevertheless:
Wenn Du die Tabelle in ein Listobject umwandelst (Strg+t oder Einfügen, Tabelle), geht das alles erheblich einfacher.

Gruß Ralf