Wie kann ich in Excel eine Datenzeile bedingt abschneiden und dauerhaft in ein anderes Arbeitsblatt verschieben?

Question

Ich habe ein Arbeitsblatt mit allen meinen Projekten aufgelistet. Wenn ich eine Zeile (Projekt) als "Finaled" aus einem Dropdown in Spalte D markiert habe, möchte ich, dass die gesamte Zeile in mein Arbeitsblatt "Final" verschoben wird und dauerhaft auf diesem Arbeitsblatt verbleibt.

Ich habe grundlegende Programmierkenntnisse und haben mit diesem Makro ...

Sub Finaled() 
    Dim i, LastRow 

    Sheets("FINALED").Range("A2:Z500").ClearContents 
    For i = 19 To LastRow 
    If Sheets("ACTIVE").Cells(i, "D").Value = "Finaled" Then 
    Sheets("ACTIVE").Cells(i, "D").EntireRow.Copy Destination:=Sheets("FINALED").Range("A" & Rows.Count).End(xlUp).Offset(1) 
    End If 
    Next i 
    End Sub 

kommen ... aber das funktioniert nicht genau, wie ich es will. Das erste Problem ist, dass es nur die Informationszeile kopiert, und wenn ich die Zeile manuell aus meinem Hauptarbeitsblatt lösche, verliere ich beim nächsten Ausführen des Makros die ursprünglich kopierten Datenzeilen auf meinem Finaled-Arbeitsblatt. Ich möchte, dass die Datenzeile vollständig abgeschnitten und in mein Arbeitsblatt "Final" verschoben wird und dort dauerhaft gespeichert wird.

Zweitens, kann diese Bewegung automatisch passieren, sobald ich die Zeile als "finaled" aus meiner Dropdown-Liste in Spalte D markieren? Oder muss ich das Makro jedes Mal manuell ausführen?

Answer 1

im VBA-Editor, doppelklicken Sie auf Ihrem Arbeitsblatt ACTIVE genannt, und das wird das Arbeitsblatts des Codemodul bringen (nicht, dass es aus einem Standardmodul unterscheidet):

Dann in diesem Blatt Modul , den Code unten ein:

Private Sub Worksheet_Change(ByVal Target As Range) 

    Dim wsData As Worksheet 
    Dim wsDest As Worksheet 
    Dim rngCheck As Range 
    Dim rngChanged As Range 
    Dim ChangedCell As Range 
    Dim rngMove As Range 

    Set wsData = Me 
    Set wsDest = Me.Parent.Sheets("FINALED") 
    Set rngCheck = wsData.Range("D19", wsData.Cells(wsData.Rows.Count, "D").End(xlUp)) 
    If rngCheck.Row < 19 Then Exit Sub 'No data 

    Application.EnableEvents = False 
    On Error GoTo ReEnableEvents 

    Set rngChanged = Intersect(rngCheck, Target) 

    If Not rngChanged Is Nothing Then 
     For Each ChangedCell In rngChanged.Cells 
      If LCase(Trim(ChangedCell.Value)) = "finaled" Then 
       Select Case (rngMove Is Nothing) 
        Case True: Set rngMove = ChangedCell 
        Case Else: Set rngMove = Union(rngMove, ChangedCell) 
       End Select 
      End If 
     Next ChangedCell 

     If Not rngMove Is Nothing Then 
      With rngMove.EntireRow 
       .Copy 
       wsDest.Cells(wsDest.Rows.Count, "A").End(xlUp).Offset(1).PasteSpecial xlPasteValues 
       .Delete xlShiftUp 
      End With 
     End If 
    End If 

ReEnableEvents: 
    Application.EnableEvents = True 
End Sub 

Nun, wenn Sie eine Zelle in der Spalte D auf „finaled“ ändern wird es automatisch in das FINALED Arbeitsblatt bewegt werden.

Auch der Grund, warum Sie Ihre Daten auf dem Arbeitsblatt verloren, war wegen dieser Zeile: Sheets("FINALED").Range("A2:Z500").ClearContents die ich nicht aufgenommen habe, weil ich glaube nicht, dass Sie das wirklich wollen.