Zeile einfügen, Formel erweitert sich nicht

Question

Hallöchen,

das einfügen einer neuen Zeile erfolgt über ein Makro welches ich im Netz gefunden habe.

Sub Zeilen_einfügen()

Application.ScreenUpdating = False
ActiveSheet.Unprotect Password:="passwort"
Selection.EntireRow.Insert
With Selection.EntireRow
.Offset(-1, 0).Resize(1).Copy
.PasteSpecial Paste:=xlPasteFormulas
End With
ActiveSheet.Protect Password:="passwort"
Application.ScreenUpdating = True
End Sub

Ich markiere hier also eine Zeile aktiviere das Makro, das Passwort wird entfernt, die Zeile kopiert, eine neue einfügt und das Passwort wird wieder gesetzt.

Soweit funktioniert es auch ausser wenn Formeln enthalten sind die auf ein anderes Tabellenblatt verweisen.

zb. wird aus:

=Ziel_Vorlage!AK29

das hier

=Ziel_Vorlage!AK29

hier eine Formel dessen Bezug im selben Tabellenblatt ist

=WENN(A213="";"#NV";"nicht zugeord.")

je nachdem welche Zeile man nun markiert wird daraus eben A212 oder A214. Bei obiger Formel funktioniert das aber nicht.

Könnte mir bitte jemand erklären wie ich obige Formel bearbeiten muss damit sie sich selbstständig erweitert?

Gruß
energun222

Answer 1

Hallo,

probier mal die folgenden Versionen:

Private Sub Bereich_erweitern_hawadruck_ec()
Dim rng As Range
Dim lngZeilen As Long
Dim lngSpalten As Long

'Bildschirmaktualisierung ausschalten
Application.ScreenUpdating = False

With ThisWorkbook.Worksheets("HaWa_Druck")

'Passwortschutz aufhaben
.Unprotect Password:="passwort"

'1. Range-Bereich festlegen
Set rng = .Range("zeileneceinfuegen")

'letzte Zeile und Spalte des Bereichs ermitteln
lngZeilen = rng.Rows.Count
lngSpalten = rng.Columns.Count

'hinter letzten Zeile des Bereichs eine Zeile einfügen
.Cells(rng.Cells(1).Row + lngZeilen, 1).EntireRow.Insert

'letzte Zeile des Bereichs kopieren und in neue Zeile einfügen
.Range(.Cells(rng.Cells(1).Row + lngZeilen - 1, rng.Cells(1).Column), .Cells(rng.Cells(1).Row + lngZeilen - 1, rng.Cells(1).Column + lngSpalten - 1)).Copy .Range(Cells(rng.Cells(1).Row + lngZeilen, rng.Cells(1).Column), Cells(rng.Cells(1).Row + lngZeilen, rng.Cells(1).Column + lngSpalten - 1))
Application.CutCopyMode = False

'Bereich um eine Zeile erweitern
rng.Resize(lngZeilen + 1, lngSpalten).Name = "zeileneceinfuegen"

'2. Range-Bereich festlegen
Set rng = .Range("ecloeschen")

'letzte Zeile und Spalte des Bereichs ermitteln
lngZeilen = rng.Rows.Count
lngSpalten = rng.Columns.Count

'Bereich um eine Zeile erweitern
rng.Resize(lngZeilen + 1, lngSpalten).Name = "ecloeschen"

'3. Range-Bereich festlegen
Set rng = .Range("ecfehlloeschen")

'letzte Zeile und Spalte des Bereichs ermitteln
lngZeilen = rng.Rows.Count
lngSpalten = rng.Columns.Count

'Bereich um eine Zeile erweitern
rng.Resize(lngZeilen + 1, lngSpalten).Name = "ecfehlloeschen"

'Passwortschutz wieder einrichten
.Protect Password:="passwort"

End With

'Bildschirmaktualisierung einschalten
Application.ScreenUpdating = True

End Sub

Private Sub Bereich_erweitern_hawa_ec()
Dim rng As Range
Dim lngZeilen As Long
Dim lngSpalten As Long
Dim strName As String

'Bildschirmaktualisierung ausschalten
Application.ScreenUpdating = False

With ThisWorkbook.Worksheets("HaWa")

'Passwortschutz aufhaben
.Unprotect Password:="passwort"

'Name des Bereichs - anpassen
strName = "zeilenhawaeinfuegen"

'Range-Bereich festlegen
Set rng = .Range(strName)

'letzte Zeile und Spalte des Bereichs ermitteln
lngZeilen = rng.Rows.Count
lngSpalten = rng.Columns.Count

'hinter letzten Zeile des Bereichs eine Zeile einfügen
.Cells(rng.Cells(1).Row + lngZeilen, 1).EntireRow.Insert

'letzte Zeile des Bereichs kopieren und in neue Zeile einfügen
.Range(.Cells(rng.Cells(1).Row + lngZeilen - 1, rng.Cells(1).Column), .Cells(rng.Cells(1).Row + lngZeilen - 1, rng.Cells(1).Column + lngSpalten - 1)).Copy

With .Range(.Cells(rng.Cells(1).Row + lngZeilen, rng.Cells(1).Column), .Cells(rng.Cells(1).Row + lngZeilen, rng.Cells(1).Column + lngSpalten - 1))
.PasteSpecial Paste:=xlPasteFormulas
End With
Application.CutCopyMode = False

'Bereich um eine Zeile erweitern
rng.Resize(lngZeilen + 1, lngSpalten).Name = strName

'Passwortschutz wieder einrichten
.Protect Password:="passwort"

End With

'Bildschirmaktualisierung einschalten
Application.ScreenUpdating = True

End Sub

Gruß

M.O.

Answer 2

Hallo M.O.

es funktioniert. Lag es am Passwortschutz?

Jetzt verschwindet meine Userform und erst nachdem ich in der Taskleiste auf die Mappe klicke ist sie wieder da? Ein Kuriosum. :-)

Gruß
energun222

Answer 3

Hallo,

die ursprünglichen Makros greifen auf das aktuelle Tabellenblatt zu. Wenn ein Makro in einem anderen Tabellenblatt ausgeführt werden soll, dann muss das dem Makro sozusagen "mitgeteilt" werden.
Dies geschieht mit der With-Anweisung und mit den Punkten vor diversen Anweisungen, wie Aufheben des Passwortschutz und einigen Range- und Cell-Befehlen.

Das Problem mit der Userform hängt mit der Ausführung des Makros zusammen. Du kannst mal versuchen die Userform wie folgt aufzurufen:

UserForm1.Show vbModeless

Gruß

M.O.

Answer 4

Hallo M.O.

gute Erklärung hatte das nähmlich mit noch 2 weiteren KOM und ASL vor wo ich nur die Änderung am Passwort Teil geändert hatte und es dann nicht funktionierte.
Mit den Punkten davor klappt es nun auch dort und meine Arbeitsmappe ist wieder ein Stück weit aufgeräumter. :-)

Bei den Userformen werd ich mch mal ein bissl mehr rein arbeiten.

Dank Dir

Gruß
energun222

Answer 5

Hallo M.O.,

ich habe mal versucht das ganze umzudrehen also das ich die letzte Zeile des Bereichs wieder löschen kann was wie folgt aussieht:

Sub Bereich_reduzieren_hawadruck_ec()
Dim rng As Range
Dim lngZeilen As Long
Dim lngSpalten As Long

'Bildschirmaktualisierung ausschalten
Application.ScreenUpdating = False

With ThisWorkbook.Worksheets("HaWa_Druck ")

'Passwortschutz aufhaben
.Unprotect Password:="passwort"

'1. Range-Bereich festlegen
Set rng = .Range("zeileneceinfuegen")

'letzte Zeile und Spalte des Bereichs ermitteln
lngZeilen = rng.Rows.Count
lngSpalten = rng.Columns.Count

'hinter letzten Zeile des Bereichs eine Zeile einfügen
.Cells(rng.Cells(1).Row + lngZeilen, 1).EntireRow.Delete


'Passwortschutz wieder einrichten
.Protect Password:="passwort"

End With

'Bildschirmaktualisierung einschalten
Application.ScreenUpdating = True

End Sub

Irgendwie verrutscht es aber in den Zeilen. Könntest mir bitte dabei helfen.


Gruß
energun222

Answer 6

Hallo energun,

eigentlich müsste das so funktionieren. Hier die abgespeckte Version:

Sub Bereich_reduzieren()
Dim rng As Range
Dim lngZeilen As Long
Dim strName As String

'Bildschirmaktualisierung ausschalten
Application.ScreenUpdating = False

With ThisWorkbook.Worksheets("HaWa_Druck")

'Passwortschutz aufhaben
.Unprotect Password:="passwort"

'Name des Bereichs
strName = "zeileneceinfuegen"

'Range-Bereich festlegen
Set rng = Range(strName)

'letzte Zeile und Spalte des Bereichs ermitteln
lngZeilen = rng.Rows.Count
lngSpalten = rng.Columns.Count

'letzte Zeile des Bereichs löschen
.Cells(rng.Cells(1).Row + lngZeilen, 1).EntireRow.Delete

'Passwortschutz wieder einrichten
.Protect Password:="passwort"

End With

'Bildschirmaktualisierung einschalten
Application.ScreenUpdating = True

End Sub

Irgendwie verrutscht es aber in den Zeilen.

Kannst du mal erklären, was du damit meinst? Du löschst ja die ganze Zeile im Arbeitsblatt.
Stehen also neben deinem definierten Bereich noch Daten, dann werden diese auch gelöscht.
Falls das so ist, würde ich nur den Inhalt der letzten Zeile des Bereichs löschen und den Bereich um eine Zeile reduzieren:

Sub Bereich_reduzieren2()
Dim rng As Range
Dim lngZeilen As Long
Dim strName As String

'Bildschirmaktualisierung ausschalten
Application.ScreenUpdating = False

With ThisWorkbook.Worksheets("HaWa_Druck")

'Passwortschutz aufhaben
.Unprotect Password:="passwort"

'Name des Bereichs - anpassen
strName = "zeileneceinfuegen"

'Range-Bereich festlegen
Set rng = Range(strName)

'letzte Zeile und Spalte des Bereichs ermitteln
lngZeilen = rng.Rows.Count
lngSpalten = rng.Columns.Count

'Inhalte der letzten Zeile des Bereichs löschen
.Range(.Cells(rng.Cells(1).Row + lngZeilen - 1, rng.Cells(1).Column), .Cells(rng.Cells(1).Row + lngZeilen - 1, rng.Cells(1).Column + lngSpalten - 1)).ClearContents

'Bereich um eine Zeile reduzieren
rng.Resize(lngZeilen - 1, lngSpalten).Name = strName

'Passwortschutz wieder einrichten
.Protect Password:="passwort"

End With

'Bildschirmaktualisierung einschalten
Application.ScreenUpdating = True

End Sub

Gruß

M.O.

Answer 7

Hallo M.O.

also neben den Bereichen steht nichts weiter. Ich hab einfach mal meine Datei als abgespeckte Version nachgebastelt und angehängt. Beschreibung ist dort auch enthalten.

https://www.dropbox.com/s/bxz9kvzlqyykrr8/test_der_50000te.xlsx?dl=0

Grüße
energun222

Answer 8

Hallo energun,

leider kann ich mit deiner Datei nichts anfangen (ist die Datei mit deinem Formelproblem).

Wenn neben den Bereichen nichts steht, dann sollte das mit den Löschen der Zeile funktionieren.
Erkläre doch mal, was du mit

Irgendwie verrutscht es aber in den Zeilen.

meinst, bzw. lade mal eine Musterdatei des betreffenden Arbeitsblatts mit deinen Makros hoch, damit man sehen kann, was
nicht funktioniert.

Gruß

M.O.

Answer 9

Hallo M.O.

entschuldige war der falsche Link :-)

hier der richtige:

https://www.dropbox.com/s/pizb6w7zlfgy09x/testfile_erweitern.xlsm?dl=0


Gruß

energun222

Answer 10

Hallo energun,

ändere in den Makros zum Reduzieren jeweils die Zeile

'letzte Zeile des Bereichs löschen
.Cells(rng.Cells(1).Row + lngZeilen, 1).EntireRow.Delete

in

'letzte Zeile des Bereichs löschen
.Cells(rng.Cells(1).Row + lngZeilen - 1, 1).EntireRow.Delete

Zur Erklärung: Mit der Variablen lngZeilen wird die Anzahl der Zeilen des gesamten Bereichs ermittelt, also von der ersten bis zur letzten Zeile. Addierst du diese Variable
zur Anfangszeile hinzu, so erhälst du nicht die letzte Zeile des Bereichs, sondern eine Zeile mehr (Bereich geht von Zeile 1 bis Zeile 5 = 5 Zeilen, 1 + 5 = 6),
Daher musst du bei der Ermittlung der letzten Zeile auch 1 abziehen (Habe ich beim ersten Mal auch übersehen :-( Aber wenigsten beim Makro Bereich_reduzieren2 richtig gemacht).

Gruß

M.O.