2 Leerzeilen nach Zahlen/Buchstabenblock

Hallo zusammen,

in meiner Tabelle sind in der Spalte A Bezeichnungen enthalten die mehrmals vorkommen können. Die Spalte A ist bereits sortiert. Ich möchte nun nach jedem Block 2 Leerzeilen einfügen. Mit einer Zeile funktioniert das super mit folgendem Code:

Sub Zeile einfügen()

Dim zeile As Integer
Dim ws As Worksheet

Set ws = Sheets("MÜ_Gesamt")

zeile = 2
Do While ws.Cells(zeile, 1) > ""
If ws.Cells(zeile, 1).Value > ws.Cells(zeile + 1, 1).Value Then
ws.Rows(zeile + 1).Insert
zeile = zeile + 1
End If

zeile = zeile + 1
Loop

End Sub

Ich habe einfach mal probiert die 1 mit 2 zu tauschen. Aber scheinbar leider funktioniert das nicht so einfach oder ich habe die falschen eingetragen.
Wie müsste ich meinen Code anpassen?

Vielen Dank für Eure Hilfe.

Liebe Grüße
Uwe

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

With Range("A1") Range(.offset(1,0), .end(xldown)).copy .End(xldown).offset(1, 0).pastespecial xlpasteall selection.removeduplicates 1, xlno Selection.copy selection(1).end(xldown).offset(1, 0) Activesheet.usedrange.sort key1:=.Cells, order1:=xlascending, header:=xlyes End with

Sub Freizeilen() Dim Sp As Integer, LR As Long, Z1 As Integer, I As Long, TB1 As Worksheet Set TB1 = Sheets("MÜ_Gesamt") Sp = 1 ' Spalte A Z1 = 2 'erste Datenzeile With TB1 LR = .Cells(.Rows.Count, Sp).End(xlUp).Row 'letzte Zeile der Spalte For I = LR To Z1 Step -1 If .Cells(I, Sp) > "" And .Cells(I - 1, Sp) > .Cells(I, Sp) Then .Rows(I).Resize(2).Insert End If Next End With End Sub

Sub Zwei_Zeilen_einfügen() Dim zeile As Long Dim ws As Worksheet Set ws = Sheets("MÜ_Gesamt") zeile = 2 Do While ws.Cells(zeile, 1) > "" If ws.Cells(zeile, 1).Value > ws.Cells(zeile + 1, 1).Value Then ws.Rows(zeile + 1 & ":" & zeile + 2).Insert zeile = zeile + 2 End If zeile = zeile + 1 Loop End Sub

Sub Zeilen_einfuegen() Dim zeile As Long Dim ws As Worksheet Set ws = Sheets("MÜ_Gesamt") With ws For zeile = .Cells(Rows.Count, 1).End(xlUp).Row - 1 To 2 Step -1 If .Cells(zeile + 1, 1).Value > .Cells(zeile, 1).Value Then .Rows(zeile + 1).Resize(2).Insert End If Next zeile End With End Sub

for i= sheets("MÜ_Gesamt").Cells(Rows.Count, 1).End(xlUp).Row to 2 step -1 If sheets("MÜ_Gesamt").Cells(zeile, 1) > sheets("MÜ_Gesamt").Cells(zeile - 1, 1) Then sheets("MÜ_Gesamt").Rows(zeile - 1).Insert zeile = zeile - 1 end if next i

Beliebteste Forumthreads (12 Monate)

2 Leerzeilen nach Zahlen/Buchstabenblock

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

2 Leerzeilen nach Zahlen/Buchstabenblock

5 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread