Makro neue Zeilen einfügen in Excel

Anonym

Hallo,

ich hoffe von euch Ihr könnt mir helfen.

Wir haben eine Excel Tabellen mit vielen Datensätzen (Zeilen).

Dort müssen wir ständig neue Zeilen einfügen für neue Datensätze.

In der Zeile sind 2 Formel hinterlegt.

Nun bin auf der suche nach einem Makro das mir die Zeilen neu einfügt, den Inhalt (Schrift Farbe usw.) löscht aber die Formel mit kopiert.

Die Anzahl der neuen Zeile variiert. 1 oder 2 oder 3 oder....

Ich habe da ein Makro gefunden das mir aber immer nur 1 Zeile einfügt und bei Zeilen mit Inhalt diesen Inhalt nicht löscht

1. Makro

Sub Zeilen_einfügen()

Application.ScreenUpdating = False

Selection.EntireRow.Insert

' ACHTUNG: Das With darf nicht 1 drüber, da sich durch das Insert die Selection ändert

With Selection.EntireRow

.FormulaR1C1 = .Offset(-1, 0).Resize(1).FormulaR1C1

End With

Application.ScreenUpdating = True

End Sub

dann habe ich noch ein 2 Makro gefunden,

hier kann ich zwar mehrere Zeile markieren und dann neue Zeilen einfügen aber wieder rum das Problem, wenn ich eine beschriebene Zeile markiere wird der Inhalt nicht gelöscht

2. Makro

Sub zelleneinfügen()

' Zeilen_einfügen Makro

' Makro am 16.09.2010 von Privat aufgezeichnet

If Selection.Areas.Count > 1 Then

MsgBox ("Bitte nicht mehrere Bereiche auswählen!")

Exit Sub

End If

Application.ScreenUpdating = False

Selection.EntireRow.Insert

' ACHTUNG: Das With darf nicht 1 drüber, da sich durch das Insert die Selection ändert

With Selection.EntireRow

.Offset(-1, 0).Resize(1).Copy

.PasteSpecial Paste:=xlPasteFormulas

' Wenn in der Zeile unter den eingefügten Zeilen eine Formel in

' Spalte B steht, dann muss die korrigiert werden

If .Resize(1, 1).Offset(.Rows.Count, 1).HasFormula Then

.Resize(1, 1).Offset(.Rows.Count, 1).FormulaR1C1 = _

.Resize(1, 1).Offset(-1, 1).FormulaR1C1

End If

End With

Application.ScreenUpdating = True

End Sub

und ab hier hätte ich gerne eure Hilfe

Ein Makro das das alles kann

mehrere Zeile einfügt
beschriebene Zeilen löscht
aber alle Formeln kopiert

ist das irgendwie möglich

ich Danke euch

BG und noch schönes WE

Gesperrte Frage. Diese Frage wurde aus der Microsoft-Support-Community migriert. Sie können darüber abstimmen, ob sie hilfreich ist, aber Sie können keine Kommentare oder Antworten hinzufügen oder der Frage folgen.

0 Kommentare

Antwort, die vom Frageautor angenommen wurde

Anonym

Hallo Steffi,

probiers mal mit Schraffur:

Sub FindenFaerben()

Dim Such As Variant

Dim arrSuch As Variant

Dim c As Range, rngC As Range

Dim FirstAddress As String

Such = Application.InputBox("Gib hier deinen Suchbegriff ein" _

& Chr(10) & " und semikolongetrennt" & Chr(10) & _

"eine 0 für Suche in ganzer Zelle" _

& Chr(10) & "eine 1 für Suche in Teil der Zelle", _

"Suchbegriff", Type:=3)

arrSuch = Split(Such, ";")

Application.ScreenUpdating = False

With ActiveSheet

With .UsedRange.Interior

.Pattern = xlNone

.TintAndShade = 0

.PatternTintAndShade = 0

End With

Set c = .UsedRange.Find(arrSuch(0), LookIn:=xlValues, _

lookat:=IIf(arrSuch(1) = 0, xlWhole, xlPart))

If Not c Is Nothing Then

FirstAddress = c.Address

With c.Interior

.Pattern = xlLightUp

.PatternColorIndex = xlAutomatic

.ColorIndex = xlAutomatic

End With

Set c = .UsedRange.FindNext(c)

Loop While Not c Is Nothing And c.Address <> FirstAddress

End If

End With

Application.ScreenUpdating = True

End Sub

Mit freundlichen Grüßen

Claus

0 Kommentare

52 zusätzliche Antworten

Deleted

Diese Antwort wurde aufgrund eines Verstoßes gegen unsere Verhaltensregeln gelöscht. Die Antwort wurde manuell gemeldet oder durch automatisierte Erkennung identifiziert, bevor Maßnahmen ergriffen wurde. Weitere Informationen finden Sie in unseren Verhaltensregeln.

Kommentare wurden deaktiviert. Weitere Informationen
Anonym

2014-09-17T04:17:43+00:00

Hallo Claus

Danke,

hat geklappt,

BG

Steffi
War diese Antwort hilfreich?

0 Kommentare Keine Kommentare
Anonym

2014-09-14T08:03:11+00:00

Hallo Steffi,

markiere zuerst die Zeilen, die eingefügt werden sollen und lasse dann das Makro laufen:

Sub test17()

Dim rngC As Range

Dim LCol As Long

Application.ScreenUpdating = False

With ActiveSheet

   LCol = .Cells(5, Columns.Count).End(xlToLeft).Column

   .Rows(4).Hidden = False

   .Rows(4).Copy

   Selection.Insert Shift:=xlDown

   For Each rngC In Intersect(Selection, _

      .Columns("A:" & Chr(LCol + 64)))

      If Not rngC.HasFormula Then

         rngC.ClearContents

      End If

   Next

   .Rows(4).Hidden = True

End With

Application.ScreenUpdating = True

'    ActiveWorkbook.Save

End Sub

Oder du lässt Zeile 4 ausgeblendet und blendest die ausgeblendet eingefügten Zeilen ein:

Sub test()

Dim rngC As Range

Dim LCol As Long

Dim LRow As Long

Application.ScreenUpdating = False

With ActiveSheet

   LCol = .Cells(5, Columns.Count).End(xlToLeft).Column

   LRow = .Cells(Rows.Count, 1).End(xlUp).Row

   .Rows(4).Copy

   Selection.Insert Shift:=xlDown

   .Rows("5:" & LRow).Hidden = False

   For Each rngC In Intersect(Selection, _

      .Columns("A:" & Chr(LCol + 64)))

      If Not rngC.HasFormula Then

         rngC.ClearContents

      End If

   Next

End With

Application.ScreenUpdating = True

'    ActiveWorkbook.Save

End Sub

Mit freundlichen Grüßen

Claus
War diese Antwort hilfreich?

0 Kommentare Keine Kommentare
Anonym

2014-09-13T21:21:06+00:00
Hi Claus,

Danke für deine Antwort.

Gerade der Blattschutz war für mich wichtig damit ich die Formeln schützen kann, vor allem wenn ich neue Zeile einfüge und die Formeln von darüber kopiere.

Dann muss natürlich da auch eine Formel vorhanden sein und nicht aus versehen gelöscht worden sein.

Hier mal noch eine andere Idee.
- ich kopiere ab sofort nur noch die ganze Zeile 4.
- diese einzige Zeile sperre ich und später sogar noch ausblenden
- diese kopierte Zeile kann ich ohne Problem einfügen
  
  egal wo
  
  egal wie oft (Anzahl)
- die eingefügten Zeile haben keinen Blattschutz
das Makro kopiert mir immer die Zeile 4 ein,

ich habe mal ein Makro mit dem Recorder erstellt:

Sub Zeilen_kopieren_und_einfügen()

'

' Zeilen_kopieren_und_einfügen Makro

'

'

Rows("4:4").Select

Selection.Copy

Rows("25:27").Select

Selection.Insert Shift:=xlDown

Application.CutCopyMode = False

ActiveWorkbook.Save

End Sub

bzw: hier wird die ausgeblendete Zeile 4 erst eingeblendet, kopiert, eingefügt und wieder ausgeblendet

Sub test17()

'

' test17 Makro

'

'

Rows("3:5").Select

Selection.EntireRow.Hidden = False

Rows("4:4").Select

Selection.Copy

Rows("13:15").Select

Selection.Insert Shift:=xlDown

Rows("4:4").Select

Selection.EntireRow.Hidden = True

Application.CutCopyMode = False

ActiveWorkbook.Save

End Sub

in beiden Sub wird aber nun immer in den Zeile "25:27" oder die "13:15", also die ich beim Aufzeichnen markiert habe, neuen Zeile eingefügt,

wie müsste der Code aus sehen wenn ich natürlich egal wo in der Tabelle die Zeilen einfügen will,

ich habe zwar ein wenig "rum getestet", habe aber kein Ergebnis gefunden,

Kannst Du mir bitte weiter helfen
War diese Antwort hilfreich?

0 Kommentare Keine Kommentare