Excel 2007 - Makro Zeile einfügen - Spalte A fortlaufende Nummer

Question

Hallo an alle,

beim stöbern hier im Forum habe ich schon folgendes passende Makro gefunden:


Option Explicit

Sub Zeile_zusätzlich()
'
Rows(ActiveCell.Row).Insert Shift:=xlDown
Rows(ActiveCell.Row - 1).Copy Range("A" & ActiveCell.Row)
End Sub


Dieses erstellt mir eine neue Zeile mit allen Formeln der Zeile über der Markierung.

Jetzt brauche ich allerdings in Spalte A eine Fortlaufende Nummer. Sprich das Makro soll die Zahl automatisch +1 Zählen.

Kurzes Beispiel wie es aussehen soll: In A1 steht 500, nun soll beim einfügen der neuen Zeile mit dem Makro automatisch in B1 nun 501 stehen usw.

Das non plus ultra wäre, wenn das Makro automatisch Zeilen mit Formeln immer bis Zeile 598 auffüllt, da immer wieder Zeilen komplett rauskopiert werden und in Zeile 600 immer eine Zusammenfassung stehen soll.

DANKE schon mal für eure Antworten

Answer 1

Hallo M.O.,

war irgendwie witzig, weil es das komplette Makro angezeigt hat (und das in jeder Spalte). Bei der neuen Version ist das nicht mehr der Fall.

Erst mal möcht ich mich bei dir für dein Engagement bedanken. Vor allem, da ich als Anfänger mich gerade so zurecht "Wurstle".

Jetzt aber wieder zurück.

Dein Makro erstellt eine neue Zeile mit einer fortlaufenden Nummer und kopiert dann die Zeile von B bis T jeweils ein Zeile tiefer, was mir die darunter stehenden Zeilen überschreibt, nicht aber mit komplett eingefügten Zeilen weiter nach unten schiebt.

Zudem fügt bzw. kopiert es jeweils nur Zeile für Zeile.

Meine Frage, ist es auch möglich, dass dieses Makro automatisch funktioniert, ohne dass ich den auslöser mache?

Gruß

Florian

Answer 2

Hallo Florian,

jetzt habe ich verstanden, was du willst, Du willst, dass von der aktuellen Zeile bis zur Zeile 589 neue Zeilen eingefügt werden und die Spalten B bis T jeweils in die neuen Zeilen eingefügt werden?

Auch ein "automatischer Auslöser" ist möglich. An was hattest du den gedacht (z.B. ein Doppelklick in Spalte A)?

Gruß

M.O.

Answer 3

Hallo,

jetzt sind wir glaub ich auf einer Linie.

Kurz noch als Beispiel:

Durch rauskopieren aus der Tabelle ist die letzte Fortlaufende NR. in Zeile 555. Damit hat sich auch die "Summenzeile" auf die Zeile 557 reduziert. Die Aufgabe des Makro soll jetzt bestehen, neue Zeilen von Zeile 556 bis 598 aufzufüllen, dabei in Spalte A die forlaufende Nr. ebenfalls von Zeile 556 bis 598 einzutragen und somit die "Summenzeile" zurück in Zeile 600 zu schieben.

Dies soll (wenn möglich) ganz automatisch passieren z. B. beim öffnen der Tabelle. (Ich hoffe, das ist dann nicht in einem Konflikt mit einem anderen Makro, das automatisch beim öffnen der Tabelle automatisch alle Zeilen ausschneidet und in ein anderes Tabellenblatt einfügt, wenn in Spalte M ein Wert eingetragen ist). ODER wenn dies deiner Meinung nach, auch zur Kontrolle, besser mit einem Klick auf den Button "Zeilen Einfügen", den ich schon eingerichtet habe.

Vielen Dank

Florian

Answer 4

Hallo Florian,

was besser ist, musst du entscheiden :-).
Ich habe das Makro jetzt so geändert, dass es auch automatisch laufen kann. Dazu wird in Spalte A im Bereich zwischen A2 und A 598 die erste Zelle ermittelt, deren Wert Null ist. Zwischen den einzelnen Nummern dürfen daher keine leere Zellen vorhanden sein.

Hier das Makro zum Ausführen über den Button:

Sub Zeile_zusätzlich()
'
Dim azeile, zeile, lnummer As Long
Dim myRange As Range

'Bildschirmaktualisierung ausschalten:
Application.ScreenUpdating = False

'höchste Zahl im Bereich zwischen A2 und A598 ermitteln
Set myRange = Worksheets("Übersicht").Range("A2:A598")
lnummer = Application.WorksheetFunction.Max(myRange)

'letzte Zeile mit einem Zahleneintrag in Spalte A ermitteln bzw. erste Zelle in der keine Zahl steht
For azeile = 2 To 598
If Worksheets("Übersicht").Cells(azeile, 1) = 0 Then Exit For
Next azeile

'Falls alle Zellen bis 598 eine Zahl beinhalten wird hier das Makro verlassen
If azeile = 599 Then Exit Sub

'Die Zellen mit den Formeln, Spalten B bis T werden bis Zeile 598 kopiert
For zeile = azeile To 598
'Zeile Einfügen
Worksheets("Übersicht").Rows(zeile).Insert Shift:=xlDown

'neue Nummer einfügen: höchste Nummer plus 1
lnummer = lnummer + 1
Worksheets("Übersicht").Cells(zeile, 1) = lnummer

'Spalten B bis T kopieren
Worksheets("Übersicht").Range(Cells(azeile - 1, 2), Cells(azeile - 1, 20)).Copy Worksheets("Übersicht").Range("B" & zeile)
Next zeile


'Bildschirmaktualisierung einschalten:
Application.ScreenUpdating = True

End Sub

Falls der Code beim Öffnen der Datei ausgeführt werden soll, so ersetze den vorhanden Code im VBA Projekt "Diese Arbeitsmappe" durch den folgenden:

Private Sub Workbook_Open()
Dim lngLetzte As Long
Dim lngZeile As Long
Dim azeile, zeile, lnummer As Long
Dim myRange As Range

'Bildschirmaktualisierung ausschalten:
Application.ScreenUpdating = False


With Worksheets("Erledigt")
lngLetzte = IIf(IsEmpty(.Cells(.Rows.Count, 2)), .Cells(.Rows.Count, 2).End(xlUp).Row, .Rows.Count) + 1
End With
With Worksheets("Übersicht")
For lngZeile = IIf(IsEmpty(.Cells(.Rows.Count, 2)), .Cells(.Rows.Count, 2).End(xlUp).Row, .Rows.Count) To 2 Step -1
If .Cells(lngZeile, 13) >= 1 Then
.Range(.Cells(lngZeile, 1), .Cells(lngZeile, 21)).Cut Worksheets("Erledigt").Cells(lngLetzte, 1)
.Rows(lngZeile).Delete
lngLetzte = lngLetzte + 1
End If
Next lngZeile
End With

'ab hier werden in der Tabelle Übersicht die Zeilen ergänzt
'höchste Zahl im Bereich zwischen A2 und A598 ermitteln
Set myRange = Worksheets("Übersicht").Range("A2:A598")
lnummer = Application.WorksheetFunction.Max(myRange)

'letzte Zeile mit einem Zahleneintrag in Spalte A ermitteln bzw. erste Zelle in der keine Zahl steht
For azeile = 2 To 598
If Worksheets("Übersicht").Cells(azeile, 1) = 0 Then Exit For
Next azeile

'Falls alle Zellen bis 598 eine Zahl beinhalten wird hier das Makro verlassen
If azeile = 599 Then Exit Sub

'Die Zellen mit den Formeln, Spalten B bis T werden bis Zeile 598 kopiert
For zeile = azeile To 598
'Zeile Einfügen
Worksheets("Übersicht").Rows(zeile).Insert Shift:=xlDown

'neue Nummer einfügen: höchste Nummer plus 1
lnummer = lnummer + 1
Worksheets("Übersicht").Cells(zeile, 1) = lnummer

'Spalten B bis T kopieren
Worksheets("Übersicht").Range(Cells(azeile - 1, 2), Cells(azeile - 1, 20)).Copy Worksheets("Übersicht").Range("B" & zeile)
Next zeile

'Bildschirmaktualisierung einschalten:
Application.ScreenUpdating = True


End Sub

Gruß

M.O.

Answer 5

PERFEKT :-) :-) :-)

Super.

Danke.

Gruß Florian