Zeile verschieben (copy/paste)

Hallo Zusammen,
ich weiß dass mein Problem hier bestimmt schon ein ausgelutschtes Thema ist, allerdings
konnte ich aus den Beiträgen nicht alle Bausteine rausarbeiten die ich für meine Anwendung brauche.
Folgendes:
Bei einem Worksheet_Change Aktion (Spalte A9-A700) ändert sich der Wert auf beendet.
Ist das der Fall soll die ganze Zeile in der dieser Wert nun drinsteht ausgeschnitten werden und auf eine neue Seite eingefügt werden.
Besonderheit: Die Zeile die ausgeschnitten werden soll, soll quasi danach gelöscht werden, sodass alle darunterliegenden Zeilen hochrutschen.
Auf dem neuen Blatt soll die nächste freie Zeile ermittelt werden in der die ausgeschnittene Zeile eingefügt wird.
In der Theorie hab ich verstanden wie der Code aufgebaut werden müsste. Doch praktisch schaff ich das nicht.
Könnte mir jemand einen Beispielcode schreiben? Das wäre super nett. Danke schon mal im Vorraus.
LG Sascha

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub ActiveWorksheet_Change (by Target Val) If Range("A9:A700").Value = "beendet" Select.EntireRow Selection.CutCopy ActiveWorksheet("Beendete Aufgaben").Cells(Count, 1).End(xlUP) = Cells(Count + 1) PasteSpecial = PasteAll End Sub

Private Sub Worksheet_Change(ByVal Target As Range) Dim Zelle As Range If Not Intersect(Target, Range("A9:A700")) Is Nothing Then Application.EnableEvents = False For Each Zelle In Intersect(Target, Range("A9:A700")) If Zelle.Value = "beendet" Then Zelle.EntireRow.Cut Tabelle2.Cells(Tabelle2.Rows.Count, 1).Offset(1).EntireRow Application.CutCopyMode = False End If Next Application.EnableEvents = True End If End Sub

@ Werner:


Sub Neue_Aufgabe()
'   Ersteller:      Sascha Nollenberger
'   Erstelldatum:   03.05.2021
'   Dieses Makro kopiert die versteckte Zeile 8 (welche vorkonfiguiert ist) und sucht sich die erste freie Zeile darunter und fügt dort eine
'   neue Zeile hinzu.
'   Mapkey:         Strg + n
Dim Zeile As Long
Rows("8:8").Select
Selection.EntireRow.Hidden = False
Selection.Copy
Rows("9:9").Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Selection.PasteSpecial Paste:=xlPasteAll
ThisWorkbook.Sheets("Neue Aufgaben").Range("E9").Value = Date
ThisWorkbook.Sheets("Neue Aufgaben").Range("F9").Value = Environ("Username")
Rows("8:8").Select
Application.CutCopyMode = False
Selection.EntireRow.Hidden = True
End Sub

Das ist der einzige Code der aktuell in meiner Liste ist. Ansonsten gibt es keinen weiteren.
@Gerd,
1. Was genau meinst du die Aktion wird nicht durch Formel aus gelöst, und Freihandzeichnung ns Modul der Tabelle Kopieren.
2. Ich habe in der Zeile Tabelle2.Cells ... die Benennung auf Tabelle3.Cells geändert da das die Destination ist wo die Zeile hinsoll.
Allerdings kommt jetzt eine Laufzeitfehler 1004,
3. Ich habe deinen Code auf das Tabellenblatt kopiert in der die Aktion starten soll.
Ich bin etwas überfordert.
LG Sascha

Private Sub Worksheet_Change(ByVal Target As Range) Dim Zelle As Range If Not Intersect(Target, Range("A9:A700")) Is Nothing Then Application.EnableEvents = False For Each Zelle In Intersect(Target, Range("A9:A700")) If Zelle.Value = "beendet" Then Zelle.EntireRow.Cut Tabelle3.Cells(Tabelle3.Rows.Count, 1).End(xlUp).Offset(1).EntireRow Application.CutCopyMode = False End If Next Application.EnableEvents = True End If End Sub

Private Sub Worksheet_Change(ByVal Target As Range) Dim Zelle As Range If Not Intersect(Target, Range("A9:A700")) Is Nothing Then Application.EnableEvents = False For Each Zelle In Intersect(Target, Range("A9:A700")) If Zelle.Value = "beendet" Then Zelle.EntireRow.Copy Tabelle3.Cells(Tabelle3.Rows.Count, 1).End(xlUp).Offset(1).EntireRow Zelle.EntireRow.Delete Application.CutCopyMode = False End If Next Application.EnableEvents = True End If End Sub

Beliebteste Forumthreads (12 Monate)

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

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

9
Beiträge zum Forumthread

Beiträge zu diesem Forumthread