VBA Zellen kopieren wenn Bedingung erfüllt

Hallo zusammen,
2. Versuch. ;-)
ich habe eine Tabelle 1 mit sämtlichen Daten und Statusmeldungen. Nun möchte ich ich die Zeile (von Spalte A bis Spalte BL) in ein neues Tabellenblatt2 verschieben (kopieren) wenn der Status "fertig" gesetzt wird. Ich habe schon etwas ähnliches gefunden, allerdings fügt das Makro die Zeile unterhalb meiner angegebenen Tabelleblatt 2 ein und bindet sie nicht in die markierte Tabelleblatt2 ein. Wenn möglich, sollte das Makro in der Tabelleblatt2 das aktuelle Datum der Fertigmeldung notieren.
Wenn mir da jemand einen Tipp geben könnte, was auch das Übertragungsdatum betrifft wäre ich echt froh.
Schon mal vielen Dank
Markus
https://www.herber.de/bbs/user/130241.xlsm

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Private Sub Worksheet_Change(ByVal Target As Range) Dim lngErste As Long If Target.Column = 13 Then 'Spalte Status If Target.Count = 1 Then If UCase(Target) = "FERTIG" Then With Worksheets("fertige Aufträge") lngErste = IIf(IsEmpty(.Cells(.Rows.Count, 1)), _ .Cells(.Rows.Count, 1).End(xlUp).Row, .Rows.Count) + 1 Rows(Target.Row).Copy .Cells(lngErste, 1).PasteSpecial Paste:=xlValues Rows(Target.Row).Delete Shift:=xlUp End With End If End If End If Dim tbl As ListObject Dim Lrow1 As Long Lrow1 = Worksheets("fertige Aufträge").Cells(Rows.Count, "A").End(xlUp).Row Set tbl = Worksheets("fertige Aufträge").ListObjects("Tabelle5") tbl.Resize tbl.Range.Resize(Lrow1) End Sub

Hallo Markus,
und hier mit Datum in Spalte BM (intelligente Tabelle vorher entsprechend erweitern)

Private Sub Worksheet_Change(ByVal Target As Range)
Dim lngErste As Long
If Target.Column = 13 Then 'Spalte Status
If Target.Count = 1 Then
If UCase(Target) = "FERTIG" Then
Application.ScreenUpdating = False
With Worksheets("fertige Aufträge")
lngErste = IIf(IsEmpty(.Cells(.Rows.Count, 1)), _
.Cells(.Rows.Count, 1).End(xlUp).Row, .Rows.Count) + 1
Range(Cells(Target.Row, "A"), Cells(Target.Row, "BL")).Copy
.Cells(lngErste, 1).PasteSpecial Paste:=xlValues
.Cells(lngErste, "BM") = Date
Rows(Target.Row).Delete Shift:=xlUp
End With
End If
End If
End If
End Sub

Und gewöhn dir an, beim Code mit Einrückungen zu arbeiten. So sieht man gleich was wohin gehört. Besonders bei If - End If bzw. With - End With sieht man dann sofort wo ggf. ein End With fehlt.
Noch was: Schau dir mal deine bedingten Formatierungen an, die sind drei und vierfach vorhanden.
Zudem kannst du die Regel für die Auswahl von "fertig" komplett raus schmeißen. Die Daten werden ja jetzt in ein Blatt verschoben, da macht die bedingte Formatierung für diesen Fall keinen Sinn mehr.
Gruß Werner

Beliebteste Forumthreads (12 Monate)

VBA Zellen kopieren wenn Bedingung erfüllt

9
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

131 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

VBA Zellen kopieren wenn Bedingung erfüllt

9 Beiträge zum Forumthread Beiträge zu diesem Forumthread

131 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

9
Beiträge zum Forumthread

Beiträge zu diesem Forumthread