Automatisches Kopieren, dann löschen

[Floxxwhite]

Hallo,

Ich weiß, dass dieses Thema schon oft aufgekommen ist. 

Mit Funktionen bin ich eigentlich ganz fit, mit einfachen Makros klappts auch ganz gut. 
Mit VBA bin ich oft überfordert! :D.
Einfachhalber hab ich mal eine Beispieldatei angehängt. 

In Sheet 1 werden immer die Daten eingetragen. 
Jeodch erstmal ohne Status (siehe d4). 
Später wird dann die Spalte bezahlt mit "ja" oder "nein" beantwortet. Dann sollen automatisch die Zeilen ausgeschnitten werden und in die jeweiligen anderen Sheets kopiert werden. 
Dann sollen die ausgeschnittenen Zeilen quasi verschwinden (oder die anderen Einträge nach oben rutschen). 
Wichtig ist, dass wenn die Einträge in das jeweilige Sheet kopiert wird, keine bestehenden Einträge überschrieben werden. 

Hier meine Gedankengänge, was ich versucht habe: 
- Mit wenn Funktion. Problem Jede Zelle mit einer Wenn Funktion auszustatten erwies sich als schwierig. ältere Einträge würden dadurch auch überschrieben, wenn man sie in "Eintragung" per Hand gelöscht hat. 


- Mit Makros die Zellen kopiert. Hat nicht so geklappt. 



Gerne darf es für das Löschen auch ein extra Button geben etc. Für Lösungsvorschläge jeder Art bin ich offen. Es muss nicht einfach zu programmieren sein (ist VBA notwendig?), es muss nur einfach zu bedienen sein!


Danke!

[AlterDresdner]

Hallo floxxwhite,
wenn Du den Code im VBA-Editor in das Blatt Eintragungen kopierst, sollte das gewünschte passieren. Wenn nicht, noch mal nachfragen.

Private Sub Worksheet_Change(ByVal Target As Range)

Dim azeile As Long, janein As String, bl As Object

  With ActiveSheet

    If Target.Column = 4 Then 'Änderung in Spalte D 

      azeile = Target.Row

      If UCase(Target.Text) = "JA" Then janein = "ja"

      If UCase(Target.Text) = "NEIN" Then janein = "nein"

      If janein <> "" Then

        Set bl = ActiveWorkbook.Sheets(janein) 'Blatt ja oder nein wählen 

        .Rows(azeile).Cut Destination:=bl.Rows(bl.Cells(Rows.Count, 1).End(xlUp).Row + 1) 'Zeile nach letzter Zeile einfügen 

        .Rows(azeile).Delete Shift:=xlUp 'Quellzeile löschen 

      End If

    End If

  End With

End Sub

Gruß der AlteDresdner

[Floxxwhite]

Hallo AlterDresdner,

vielen Dank für die Antwort. Das Script hat super funktioniert. Die Anpassung auf das konkrete Beispiel hat super funktioniert! Auch deine Anmerkungen im Code haben mir beim Verständnis sehr gut geholfen. 

Meine Kollegen und Ich danke dir wirklich sehr!! :100: