Schleife - Zellen finden Zeilen/Inhalt einfügen

Hallo,
leider komme ich hier nicht weiter - ich benötige eine Schleife, die zunächst meine Daten nach B:B = 00 sortiert, im Anschluß eine Leerzeile oberhalb der Zeile mit Inhalt 00 einfügt und dann weiter nach B:B = 01 sucht. Immer wenn B = 01, dann soll der komplette Inhalt aus der Zeile mit 00 kopiert und oberhalb eingfügt werden.
Die Ausleitung sieht anfangs wie folgt aus:
__A__B___C____D
1_1__00__Text__02.02.2009
2_2__01__Text
3_3__01__Text
4_1__00__Text__12.02.2009
5_2__01__Text
6_3__02__Text
7_1__00__Text__02.01.2009
Die Daten nach der Sortierung nach Inhalt 00 und dem Einfügen der Leerzeilen:
__A__B___C____D
1_1__00__Text__02.02.2009
2_2__01__Text
3_3__01__Text
4
5_1__00__Text__12.02.2009
6_2__01__Text
7_3__02__Text
8
9_1__00__Text__02.01.2009
Die Daten nach der Sortierung nach Inhalt 01 und dem Einfügen der Zeilen mit 00:
__A__B___C____D
1_1__00__Text__02.02.2009
2_2__01__Text
3
4_1__00__Text__02.02.2009
5_3__01__Text
6
7_1__00__Text__12.02.2009
8_2__01__Text
9_3__02__Text
10
11_1__00__Text__02.01.2009
Hört sich bestimmt schwieriger an, als es für Euch Profis ist oder?!?!?
Danke für Euere Hilfe und Gruß, Stefan

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo,
sorry - bin das erste Mal hier im Forum...
Habe nun eine Bsp.-Datei (Ist-Stand) https://www.herber.de/bbs/user/59681.xls
und eine Bsp.-Datei (Soll-Stand) https://www.herber.de/bbs/user/59683.xls hochgeladen.
Mein Code sieht derzeit so aus:


Sub ZeileEinfügen()
For i = Cells(Rows.Count, 2).End(xlUp).Row To 1 Step -1
If Cells(i, 2) = 0 Then
Rows(i).Insert
End If
Next
Rows("1:2").Select
Selection.Delete Shift:=xlUp
End Sub


Sub SortierenNach02()
Dim lngRow As Long, B As Long
lngRow = Cells(Rows.Count, "B").End(xlUp).Row
For B = lngRow To 1 Step -1
If Cells(B, 2) = "02" Then
Rows(Cells(B, 1).Row).Insert Shift:=xlDown
End If
Next
End Sub

Wäre super, wenn Du mir weiterhelfen könntest, danke. Stefan

Sub Strukturieren() Dim lRow As Long, lRowCopy As Long lRow = 1 Do If ActiveSheet.Cells(lRow, 2).Value = "00" Then lRowCopy = lRow End If If IsEmpty(ActiveSheet.Cells(lRow, 2)) And _ ActiveSheet.Cells(lRow + 1, 2).Value "00" Then ActiveSheet.Rows(lRow).Insert shift:=xlDown lRow = lRow + 1 ActiveSheet.Rows(lRowCopy).Copy Destination:=ActiveSheet.Rows(lRow) End If lRow = lRow + 1 Loop While Not (IsEmpty(ActiveSheet.Cells(lRow + 1, 2)) And _ IsEmpty(ActiveSheet.Cells(lRow + 2, 2))) End Sub

Beliebteste Forumthreads (12 Monate)

Schleife - Zellen finden Zeilen/Inhalt einfügen

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

312 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Schleife - Zellen finden Zeilen/Inhalt einfügen

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

312 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread