Office: Zeile bei Bedingung in anderen Reiter kopieren

Hallo zusammen,
ich habe eine Excel Tabelle mit verschiedenen To Dos für mich. Jedes Mal, wenn ich eine Zeile in Spalte G als "done" markiere möchte ich, dass die komplette Zeile in einen anderen Reiter "erledigt" verschoben wird. Dafür habe ich folgenden Code erstellt:

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
Dim ZielZeile As Long
ZielZeile = Sheets("erledigt").Cells(Rows.Count, 1).End(xlUp)
Set Target = Intersect(Target, Range("G1:G1000"))
If Target Is Nothing Then Exit Sub
If Target = "done" Then
Target.EntireRow.Copy Destination:=Sheets("erledigt").Cells(ZielZeile + 1, 1)
Target.EntireRow.Delete
End If
End Sub

Das klappt zwar halbwegs, mein Problem ist aber, dass die Zeile im Erledigt Reiter irgendwo in Spalte 50.000 auftaucht und nicht oben. Kann mir jemand weiterhelfen woran das liegt? Ich bin totaler Anfänger was das angeht...

 

Moin Dan,
nur so als Ansatz: Dein Ziel ist im Moment, dass der erledigte Eintrag unten in der entsprechenden Tabelle angefügt wird. Ich würde den Spieß umdrehen: Füge in der erl.-Tabelle oben eine Zeile ein und kopiere aus ToDo-Tabelle dorthin.

Du sparst Dir die Zeilenzählerei und hast die letzten Einträge immer übersichtlich oben:

Code:

Option Explicit

Sub Versiv()

With ThisWorkbook.Sheets("Tabelle2")
    .Rows(1).Insert    'hast du Überschriften, ersetze 1 durch 2
End With

End Sub

Nachtrag: Falls Du meinen Code (mangels Kenntnis) noch nicht erfolgreich einbauen kannst, lass es mich wissen, dann mach ich das für Dich. Aber trau Dich ruhig. So schwer ist's nicht

Schöne Grüße

 

Hey, vielen Dank schonmal! Die Idee die Zeile oben einzufügen finde ich auch super!
Leider schaffe ich es tatsächlich nicht so ganz den Code einzufügen... Ich dachte ich muss nur den Part mit der ZielZeile ändern, aber das klappt nicht. Würdest du mir da echt doch nochmal weiterhelfen?

 

Moin Dan,
schmeiss aus Deinem Code die ersten zwei Zeilen raus, die "ZielZeile" enthalten und ändere

Code:

Target.EntireRow.Copy Destination:=Sheets("erledigt").Cells(1, 1)

Wenn Du Überschriften hast, nimmst Du statt cells(1,1) einfach cells(2,1)
Das sollte schon funktionieren.

Nachtrag: HALT!! Stimmt nicht! Du brauchst ja noch das Einfügen der Zeile. Gib mir ein paar Minuten und Du bekommst den kompletten Code Sorry.

Schöne Grüße

 

Jetzt aber ...

Code:

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
Set Target = Intersect(Target, Range("G1:G1000"))
If Target Is Nothing Then Exit Sub

If Target = "done" Then
    Sheets("erledigt").Rows(1).Insert
    Target.EntireRow.Copy Destination:=Sheets("erledigt").Cells(1, 1)
    Target.EntireRow.Delete
End If

End Sub

Grüße

 

Kleine Spielerei hinterher: Mit folgendem Code schriebst Du statt dem "done" in Deine Erledigt-Tabelle auch noch, WANN Du Deinen Job erledigt hast:

Code:

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
Dim sDate As String

Set Target = Intersect(Target, Range("G1:G1000"))
If Target Is Nothing Then Exit Sub

If Target = "done" Then
    sDate = Now
    Sheets("erledigt").Rows(1).Insert
    Target.EntireRow.Copy Destination:=Sheets("erledigt").Cells(1, 1)
    Sheets("erledigt").Cells(1, 7) = sDate
    Target.EntireRow.Delete
End If

End Sub

Viel Spaß!

 

So - und noch eine Spielerei: Angenommen, Du willst Deine ToDo-Liste noch etwas besser strukturieren und legst für jeden Aufgabenbereich eine eigene Tabelle (Haus, Hof, Garten) an. Dann gibst Du jeder dieser Tabellen diesen Code mit:

Code:

Option Explicit

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Target.Column = 7 Then
    Version Target
    Cancel = True
End If
End Sub

Der Unterschied besteht darin, dass Du 1.) die komplette Spalte G prüfst (nicht nur bis Zeile 1000), ABER 2.) nicht beim SelectionChange, sondern auf Doppelklick. So kannst Du m.E. gezielter arbeiten. Die Zeile Cancel = True verhindert das die ausgewählte Zelle aktiv bleibt.

In ein Allgemeines Modul gehört dann diese verallgemeinerte Variante der bisherigen Codes:

Code:

Option Explicit

Sub Version(ByVal Target As Range)
Dim sDate As String

With ActiveSheet
     If Target Is Nothing Then Exit Sub

     If Target = "done" Then
         sDate = Now
         Sheets("erledigt").Rows(1).Insert
         Target.EntireRow.Copy Destination:=Sheets("erledigt").Cells(1, 1)
         Sheets("erledigt").Cells(1, 7) = sDate
         Target.EntireRow.Delete
     End If
End With
End Sub

Wenn ich den Code noch hilfreich kommentieren soll, lass es mich wissen.

Grüße

 

Wow Danke für deine Mühe - es funktioniert endlich!!!!

Mit den Spielereien beschäftige ich mich jetzt als nächstes, das sind auch super Ideen!

 

Es kommt noch besser
Take a look: Kleine ToDo-Liste -
Grüße