Clever-Excel-Forum

Normale Version: Liste mit Makros sortieren und abgeschlossene Projekte in neues Blatt verschieben
Du siehst gerade eine vereinfachte Darstellung unserer Inhalte. Normale Ansicht mit richtiger Formatierung.
Hallo zusammen!

Ich habe ein kleines Problem und komme nicht so richtig weiter.

Aufgabenstellung:
- Liste mit abzuarbeitenden Projekten
- Liste soll nach Projekten und Datum sortiert sein, so dass sich Projektblöcke ergeben
- Zwischen jedem Block soll eine Leerzeile eingefügt werden
- Ist ein Projekt abgearbeitet wird in Spalte R ein "X" gesetzt
- Anschließend soll die abgearbeitete Zeile in eine separates Blatt verschoben werden und an der Ursprungsstelle gelöscht werden
- Die Sortierfunktion soll auch im Archiv erhalten bleiben, so dass auch hier abgearbeitete Blöcke entstehen.

Ich habe alles hinbekommen, dass es funktioniert, aber nicht alles zusammen.

- Makro zum "Sortieren" erstellt. klappt
- Code zum Einfügen der Leerzeilen klappt auch (VBA)
- Button erstellt, der sortiert und die Leerzeilen einfügt klappt auch
- Code zum Verschieben der Zeilen klappt auch, aber es gibt einen Fehler, wenn man wieder sortieren will (Fehler 13). Lösche ich die Zeilen mit der Verschiebefunktion raus, klappt das sortieren und einfügen der Leerzeilen per Button wieder

Kann mir jemand sagen wo mein Fehler liegt?
Tausend Dank im Voraus! Anbei die Liste!

Schöne Grüße PyRO
Hier noch der Code:

Option Explicit
Dim i As Long
Dim lastrow As Long
Sub leerzeilen()
lastrow = UsedRange.SpecialCells(xlCellTypeLastCell).Row
For i = lastrow To 3 Step -1
  If Cells(i, 2).Value = "" Or Cells(i - 1, 2).Value = "" Then
  ElseIf Cells(i, 2).Value <> Cells(i - 1, 2).Value Then
    Rows(i).Insert
  End If
Next i
End Sub

Private Sub CommandButton1_Click()
Call Sortieren
Call leerzeilen
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 18 And Target = "x" Then   /// Hier kommt der Fehler (Laufzeitfehler 13)
Rows(Target.Row).Copy
Sheets("archiv").Rows("2:2").Insert Shift:=xlDown
Application.EnableEvents = False
Rows(Target.Row).Delete
Application.EnableEvents = True
End If
End Sub
Hallo,

nicht getestet: If Target.Column = 18 And Target.Text = "x" Then