VBA Zeilen verschieben wenn Bedingungen erfüllt

[DanOnline]

Hallo zusammen,

ich habe folgendes Problem:
In Tabellenblatt 1 (Name: Projekt) habe ich eine Liste mit allen Aktivitäten, welche ich noch zu erledigen habe. Die Punkte, die ich erledigt habe, markiere ich in Spalte M mit einem "100%". In jeder Spalte ist ein ToDo-Punkt.
Alle mit "100%" markierten ToDO-Punkte (Zeilen) würde ich gerne automatisch in Tabellenblatt 2 (Name: Archiv) ab Zeile 7 verschieben lassen.

Ich hoffe ich hab mich verständlich ausgedrückt und bitte um eure unterstützung.
Meine VBA Kentnisse halten sich noch ziemlich in Grenzen... :20:

Vielen Dank im Voraus.

Grüße
Dan

[atilla]

Hallo,

füge folgenden Code in das Codefenster der Tabelle "Projekt" ein.
Und sobald in Spalte Status ein Wert verändert wird, sollte das Passieren, was Du möchtest.

Code:

Private Sub Worksheet_Change(ByVal Target As Range)
 Dim lngZ As Long
 If Not Intersect(Target, Range("Tabelle3[Status]")) Is Nothing Then
   With Sheets("Archiv")
     lngZ = .Range("Tabelle32[Art]").End(xlUp).Row + 1
     .Range(.Cells(lngZ, 1), .Cells(lngZ, 14)).Value = Range(Cells(Target.Row, 1), Cells(Target.Row, 14)).Value
   End With
   Range(Cells(Target.Row, 1), Cells(Target.Row, 14)).ClearContents
   Application.EnableEvents = False
   Tabelle_Projekt_sortieren
   Application.EnableEvents = True
 End If
End Sub

Sub Tabelle_Projekt_sortieren()

 With ActiveWorkbook.Worksheets("Projekt").ListObjects("Tabelle3").Sort
   .SortFields.Clear
   .SortFields.Add Key:=Range("Tabelle3[AP" & Chr(10) & "]"), SortOn:=xlSortOnValues, Order:= _
   xlAscending, DataOption:=xlSortNormal
   .Header = xlYes
   .MatchCase = False
   .Orientation = xlTopToBottom
   .SortMethod = xlPinYin
   .Apply
 End With
 
End Sub