Leere Zeilen mit Formatierung einfügen (VBA)

Question

Hallo,

ich habe folgendes Problem: ich möchte eine Excel-Tabelle überarbeiten. Zur besseren Übersicht sollen nach jeder Zeile zwei leere Zeilen eingefügt werden. Die erste Zeile sollte jedoch mit einem Rahmen (jede Zelle jeder Spalte separat) formatiert sein. Folgende Lösung habe ich bereits gefunden:

Sub Leerzeilen()
Set wksTemp = ActiveSheet
Menge = wksTemp.UsedRange.Rows.Count
For i = Menge To 6 Step -1
Menge1 = i & ":" & i
Rows(Menge1).Select
Selection.Insert Shift:=xlDown
Selection.Insert Shift:=xlDown
Next
End Sub

Jetzt fehlt aber nur noch, dass die erste Zeile einen Rahmen (für jede Zelle) erhält.

Bitte um Hilfe! Danke!

Gruß Bernhard

Answer 1

Also Deinen Code oben kann ich nicht nachvollziehen, insbesondere hat er ja nicht wirklich etwas mit einem Rahmen zu tun? Oder?

Habe hier mal einen Code, falls ich Dich richtig verstanden habe solltest Du damit zurechtkommen. Es wird hier als Beispiel im Zellenbereich von B2 bis P5 um jede Zelle ein Rahmen gesetzt, die einen Inhalt hat. Wenn Du das nur in der ersten Zeile möchtest, dann ersetzt Du jetzt zweimal Range("B2:P5") durch Range("A1:DeineletzteSpalte1"). oder du fragst nochmal nach, dann schreibe ich dir wie Du die letzte beschriebene Spalte ermittelst, das findest Du hier aber auch schon mehrfach.

Sub Einrahmen()
Application.ScreenUpdating = False
For Each Zelle In Range("B2:P5")
With Zelle.Borders(xlEdgeLeft)
.LineStyle = xlNone
End With
With Zelle.Borders(xlEdgeTop)
.LineStyle = xlNone
End With
With Zelle.Borders(xlEdgeBottom)
.LineStyle = xlNone
End With
With Zelle.Borders(xlEdgeRight)
.LineStyle = xlNone
End With
Next
For Each Zelle In Range("B2:P5")
If Zelle <> "" Then
With Zelle.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Zelle.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Zelle.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Zelle.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
End If
Next
Application.ScreenUpdating = True
End Sub

Gruß Marie

Answer 2

Hallo,

Marie danke für deine Antwort. Leider geht diese nicht in die gewünschte Richtung. Hier nocheinmal mein Problem.

Der (vorläufige) oben dargestellter Code hat einfach nur den Zweck, dass zwei leere Zeilen nach jeder Zeile mit Inhalt eingefüllt werden. Dh ich habe eine Tabelle, die mit Werten gefüllt ist (zB A1:D10). Dh mit dem oben genannten Code werden einfach zwei leere Zeilen nach jeder Zeile mit Inhalt eingefügt.

Zu meinem Problem: Jetzt möchte ich aber, dass jede Zelle in der ersten eingefügten Zeile einen Rahmen erhält. Die zweite leere Zeile sollte weiterhin ohne Rahmen bleiben.

Ich hoffe, meine Frage ist nun klarer geworden.

Danke!

LG Elec

Answer 3

Hallo Elec,

dann versuche es mal mit nachfolgenden Code, der Dir in der ersten Leerzeile einen Rahmen um den Bereich A:D der entsprechenden Zeile macht.

Kopiere das Makro in ein StandardModul und starte es z.B. über eine Befehlsschaltfläche
Teste das Makro aber bitte in einer Testdatei und nicht gleich in Deiner Originaldatei.

Option Explicit

Sub Leerzeilen()
Dim i As Integer
Dim Menge As Integer

Application.ScreenUpdating = False

Menge = ActiveSheet.UsedRange.Rows.Count

For i = Menge To 6 Step -1
Rows(i).Insert Shift:=xlDown
Rows(i).Insert Shift:=xlDown
With Range(Cells(i, 1), Cells(i, 4))
With .Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With .Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With .Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With .Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
End With
Next
End Sub
MfG,
Oliver
[sub]Da hier der einzige Lohn für die Helfer eine Rückmeldung ist, wäre es nett, wenn Du[/sub]
[sup] ein Feedback abgeben könntest, ob der Lösungsvorschlag Dein Problem gelöst hat.[/sup]

Answer 4

Hallo Oliver,

super, passt schon fast perfekt!!! Vielen DANK!

Eine Frage dazu hätte ich noch: Wäre es auch möglich, dass zB jede Zelle im Bereich A:D einen eigenen Rahmen bekommt (nicht nur der gesamte Bereich)? Dann hätte ich genau das, was wollte.

Gruß Elec

Answer 5

Halo Elec,

dann sieht das Makro wie folgt aus:

Option Explicit

Sub Leerzeilen()
Dim i As Integer
Dim Menge As Integer

Application.ScreenUpdating = False

Menge = ActiveSheet.UsedRange.Rows.Count

For i = Menge To 6 Step -1
Rows(i).Insert Shift:=xlDown
Rows(i).Insert Shift:=xlDown
With Range(Cells(i, 1), Cells(i, 4))
With .Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With .Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With .Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With .Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With .Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With .Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
End With
Next
End Sub
MfG,
Oliver
[sub]Da hier der einzige Lohn für die Helfer eine Rückmeldung ist, wäre es nett, wenn Du[/sub]
[sup] ein Feedback abgeben könntest, ob der Lösungsvorschlag Dein Problem gelöst hat.[/sup]

Answer 6

Hallo Oliver,

super, perfekt. Genau das, was ich gesucht habe!!!
Vielen Dank!!!

Gruß Elec