В Excel, как я могу условно разрезать ряд данных и перенести их на другой рабочий лист постоянно?

Question

У меня есть рабочий лист со всеми моими проектами. Когда я помечал одну строку (проект) как «Finalted» из выпадающего столбца D, я хочу, чтобы вся строка была перемещена на мой «Finalted» рабочий лист и постоянно оставалась на этом листе.

У меня есть базовые знания программирования, и придумали эту Macro ...

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 

... но это не работает так же, как я хочу его. Первая проблема заключается в том, что она копирует только строку информации, и когда я вручную удаляю строку из моего основного рабочего листа, в следующий раз, когда я запустим макрос, я потеряю первоначально скопированные строки данных на моем рабочем листе Finaled. Я хочу, чтобы он полностью отрезал строку данных и переместил их на мой рабочий лист «Finalted» и сохранил его навсегда.

Во-вторых, может ли этот ход произойти автоматически, как только я помету строку как «окончательную» из моего выпадающего списка в столбце D? Или мне нужно вручную запускать Macro каждый раз?

Answer 1

В редакторе VBA, DoubleClick на листе с именем ACTIVE и появится модуль кода, который рабочего листа (не то, что он отличается от стандартного модуля):

Затем в этом модуле листа вставьте код ниже:

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 

Теперь, когда вы измените ячейку в столбце D, чтобы «finaled» будет автоматически перемещен в FINALED лист.

Кроме того, причина, по которой вы теряли свои данные на листе FINALED, была из-за этой строки: Sheets("FINALED").Range("A2:Z500").ClearContents, которую я не включил, потому что я не думаю, что вы действительно этого хотите.