Zeilen bei Event Kopieren

Hallo liebe Excel Gemeinde,
ich hänge aktuell an einem Problem für das ich Bereits einige Ansätze gefunden habe. Konkret umsetzten kann ich es aber nicht.
Ich arbeite an einer ToDo Liste, welche offene und geschlossene Aktivitäten anzeigt.
Nun soll wenn in der Spalte D ab Zelle 2-39 per Dropdown "Abgeschlossen" ausgewählt wird, die entsprechende Spalte (z.B. B2-I2) in die nächste freie Spalte ab 38 ausgeschnitten und eingefügt werden.
Idealerweise würden die nun restlichen offenen ToDos (B2-I2 bis B39-I39) noch aufrücken und die entstandene Lücke wieder schließen.
Wenn es dies stark vereinfacht, könnte ich bei Auswahl Abgeschlossen die ganze Spalte auch auf ein neues Tabellenblatt einfügen.
https://www.herber.de/bbs/user/127853.xlsx
Kann mir hierbei einer von euch helfen?
Viele Grüße,
Benjamin

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Benjamin,
etwa wie folgt,
LG
Franz


'Ereignis-Makro unter dem Tabellenblatt
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Zellen As Range
Dim Zeile As Long
Dim Zeile_L As Long
Dim Zei_1 As Long
Dim Zei_L As Long
Zei_1 = 2  '1. Zeile, die in Spalte D überwacht werden soll
Zei_L = 39  'Letzte Zeile, die in Spalte D überwacht werden soll
If Not Application.Intersect(Target, Range("D" & Zei_1 & ":D" & Zei_L)) Is Nothing Then
'Ereignismakros deaktivieren
Application.EnableEvents = False
'Letzte Zeile mit abgeschlossener Aktion
Zeile_L = Cells(Rows.Count, 4).End(xlUp).Row
'Zeilen abarbeiten
For Zeile = Zei_1 To Zei_L
'Inhalt in Spalte D prüfen
If Cells(Zeile, 4) = "Abgeschlossen" Then
'Sicherheits-Abfrage vor Verschieben
If MsgBox("Zeile " & Zeile & " als ""Abgeschlossen"" verschieben?", vbQuestion + _
vbYesNo, _
"Abgeschlossen verschieben") = vbYes Then
'zu kopierenden Bereich setzen (Spalten B bis I in Zeile)
Set Zellen = Range(Cells(Zeile, 2), Cells(Zeile, 9))
'Zeile in die verschoben werden soll
Zeile_L = Zeile_L + 1
'Bereich kopieren
Zellen.Copy Destination:=Cells(Zeile_L, 2)
'Inhalt in kopiertem bereich löschen
Zellen.ClearContents
'Zeilen-Nr. für kopieren Eintrag eintragen
Cells(Zeile_L, 1) = Zeile_L - Zei_L - 1
'verschobenen Inhalt in Spalte N mit höherer Zahl markieren
Cells(Zeile, 14) = Zei_L + 1
Else
'abgeschlossene Aktion in Spalte N mit Zeilen-Nummer markieren, wenn nicht  _
verschoben
Cells(Zeile, 14) = Zeile
End If
Else
'nicht abgeschlossenen Eintrag in Spalte N mit Zeilen-Nummer markieren
Cells(Zeile, 14) = Zeile
End If
Next
'Einträge nach Nummer in Spalte N sortieren - verschibet Leerzeilen der verschobenenn _
Einträge ans Ende der Liste
Range("B" & Zei_1 & ":N" & Zei_L).Sort key1:=Range("N" & Zei_1), Order1:=xlAscending,  _
Header:=xlNo
'Hilfsnummern wieder löschen
Range("N" & Zei_1 & ":N" & Zei_L).ClearContents
'Ereignismakros wieder löschen
Application.EnableEvents = True
End If
End Sub

Beliebteste Forumthreads (12 Monate)

3 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread