PDA

Vollständige Version anzeigen : Übertragung bestimmter Zellen anhand eines Kriteriums


Filterproblem
21.07.2014, 13:58
Hallo zusammen,

meine Aufgabenstellung ist wie folgt:
In sheet1 werden laufend Daten eingegeben.
Wenn in der Spalte "Value" ein Betrag >= größer als 2000 eingetragen wird, sollen ausgewählte Teile der jeweiligen Zeile in sheet2 übernommen werden.
Die laufend eingegeben Daten sollen bei einer Neueingabe nicht komplett übernommen werden, sondern lediglich der letzte Eintrag, damit eine Bearbeitung der übernommenen Daten in sheet2 nicht rückgängig gemacht wird.

Im Anhang befindet sich eine vereinfachte Beispieldatei, die das Prozedere verdeutlicht.
Das verwendete Makro funktioniert insofern, dass es die jeweiligen Daten aus sheet1 in sheet2 übernimmt.

Mein Problem ist nun, dass mir keine darauf aufbauende Lösung einfällt, wie nur die letzte eingegebene Zeile, wenn diese das Kriterium Value erfüllt (>= 2000), ans Ende von sheet2 übernommen werden kann.

Ich hoffe ich habe mich klar ausgedrückt und bitte um Rückmeldungen

mit besten Grüßen
Filterproblem

Crazy Tom
21.07.2014, 17:15
Hallo

das würde ich so machen
Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column <> 6 Then Exit Sub
If Target.Offset(0, -3).Value >= 2000 Then
Range(Cells(Target.Row, 1), Cells(Target.Row, 3)).Copy
Worksheets("Sheet2").Cells(2, 1).PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
End If
End Sub
in diesem Fall wird direkt kopiert sobald in Spalte F etwas eingetragen wird
und der Wert in Spalte C >=2000 ist

xlph
21.07.2014, 17:34
Hallo Filterproblem,

siehe Datei-Anhang.

Filterproblem
22.07.2014, 09:18
@ Crazy Tom:
Danke für deine Rückmeldung.
Deinen Code habe ich nun umgeschrieben, damit die Daten in die letzte Zeile überführt werden. Jedoch wird bei einer Neueingabe in "sheet1" immer die gleiche Zeile in "sheet2" überschrieben.
Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column <> 6 Then Exit Sub
If Target.Offset(0, -3).Value >= 2000 Then
Range(Cells(Target.Row, 1), Cells(Target.Row, 3)).Copy
Sheets("Sheet2").Cells(Rows.count, 1).End(xlUp).PasteSpecial Paste:=xlPasteValues Application.CutCopyMode = False
End If
End Sub


@ xlph:
Ebenfalls Danke für deine Rückmeldung.

Die Übertragung der Daten von "sheet1" nach "sheet2 hinter der letzten ausgefüllten Zeile funktioniert einwandfrei.

Mir sind nun aber weitere Probleme aufgefallen:
1) Wenn eine Zeile in "sheet1" geändert wird, wird diese als neue Zeile in "sheet2" eingefügt.
2) Weiter ist es möglich eine Nummer, die schon verwendet wurde, noch einmal einzugeben.

Ich hoffe ich habe mich verständlich ausgedrückt und bitte um Rückmeldungen, ob Ihr eine Lösung für dieses Problem parat habt.

mit besten Grüßen
Filterproblem

xlph
22.07.2014, 20:06
Hallo Filterproblem,

ich habe die Datei nochmal bearbeitet.
Es ist eine ID-Spalte hinzugekommen.

Filterproblem
23.07.2014, 11:02
Danke xlph, funktioniert nun alles wie gewünscht

mit besten Grüßen
Filterproblem