VBA Code Zeilen verbinden

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub Test() Dim Zeile As Long Dim Spalte As Long '--- Leerzeilen einfügen: With Sheets("Export") .Range(.Cells(2, 1), .Cells(2, 1).End(xlDown)).Copy .Cells(2, 1).End(xlDown).Offset(1, 0).PasteSpecial xlPasteAll .Range(.Cells(1, 1), .Cells(2, 1).End(xlDown)).EntireRow.Sort _ key1:=.Cells(1, 1), order1:=xlAscending, Header:=xlYes End With '--- Verbinden With Sheets("Export") For Zeile = 2 To .Cells(2, 1).End(xlDown).Row Step 2 For Spalte = 1 To .Cells(1, 2).End(xlToRight).Column Select Case Spalte Case 1, 15 To 16 Case Else .Cells(Zeile, Spalte).Resize(2, 1).MergeCells = True End Select Next Next End With End Sub

Hi
bist du sicher dass es ein Fehler ist und nicht nur ein Warnhinweis von Excel, weil es jetzt den Inhalte der zweiten Zelle löschen wird?
Den Warnhinweis bzw die Rückfrage ob die Aktion auch wirklich ausgeführt werden soll könnte man vermutlich durch ein vorangestelltes Application.DisplayAlerts = False (vor der Schleife) verhindern, dann stellt Excel diese Rückfragen nicht mehr.
nach der Schleife aktiviert man die Systemrückfragen wieder mit Application.DisplayAlerts = True
die bessere Lösung wäre ja gewesen, dass man diese Zählnummer zum einsortieren der Leerzeilen zusätzlich einfügt und hinterher wieder löscht, aber da die Zählnummer ja schon vorhanden war und du die Spalte A explizit nicht verbinden wolltest, habe ich mir diesen Aufwand gespart und die vorhandene Zählnummer in A verwendet.
Gruß Daniel

Hallo,
ok alles soweit zum laufen bekommen. Jetzt soll das Ganze noch mit Rahmen formatiert werden.
Kannst Du mir dabei noch helfen?
Das Ganze sieht bei mir dann so aus:

Sub Test()
Dim Zeile As Long
Dim Spalte As Long
'--- Leerzeilen einfügen:
With Sheets("KSW_ESW Übersicht")
.Range(.Cells(2, 1), .Cells(2, 1).End(xlDown)).Copy
.Cells(2, 1).End(xlDown).Offset(1, 0).PasteSpecial xlPasteAll
.Range(.Cells(1, 1), .Cells(2, 1).End(xlDown)).EntireRow.Sort _
key1:=.Cells(1, 1), order1:=xlAscending, Header:=xlYes
End With
'--- Zeilen färben
With Sheets("KSW_ESW Übersicht")
For Zeile = 2 To .Cells(2, 1).End(xlDown).Row Step 4
.Cells(Zeile, 1).Resize(2, .UsedRange.Columns.Count).Interior.Color = RGB(200, 200, 200)
Next
End With
'--- Zellen verbinden
With Sheets("KSW_ESW Übersicht")
For Zeile = 2 To .Cells(2, 1).End(xlDown).Row Step 2
For Spalte = 1 To .Cells(1, 2).End(xlToRight).Column
Select Case Spalte
Case 29 To 30
Case Else
Application.DisplayAlerts = False
.Cells(Zeile, Spalte).Resize(2, 1).MergeCells = True
Application.DisplayAlerts = True
End Select
Next
Next
End With
End Sub

Gruß Tom

Sub Rahmen() '---- Rahmen ziehen Dim Rahmen As Range ' Bereich festlegen Set Rahmen = ActiveSheet.UsedRange ' Hier soll der Range dynamisch ermittelt _ werden With Rahmen .Borders(xlEdgeLeft).LineStyle = xlContinuous .Borders(xlEdgeLeft).LineStyle = xlContinuous ' Links .Borders(xlEdgeTop).LineStyle = xlContinuous ' Oben .Borders(xlEdgeBottom).LineStyle = xlContinuous ' Unten .Borders(xlEdgeRight).LineStyle = xlContinuous ' Rechts .Borders(xlInsideVertical).LineStyle = xlContinuous ' Innen senkrecht .Borders(xlInsideHorizontal).LineStyle = xlContinuous ' Innen waagerecht End With Set Rahmen = Nothing End Sub

Beliebteste Forumthreads (12 Monate)

14
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

299 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

VBA Code Zeilen verbinden

14 Beiträge zum Forumthread Beiträge zu diesem Forumthread

299 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

14
Beiträge zum Forumthread

Beiträge zu diesem Forumthread