问如果我在带有标题“Status”的表中将下拉值更改为“已完成”(这将对整个列运行)，但只能对单元格执行。

EN

Private Sub Worksheet_Change(ByVal Target As Range)
 If Not Target.ListObject Is Nothing Then
    If Intersect(Target.ListObject.HeaderRowRange, _
            Target.EntireColumn).value = "Status" Then
        If Target.value = "Completed" Then
             Call Completedarc(Target) 'added an argument...
        End If
    End If
 End If
End Sub

Sub Completedarc(Target As Range)
  Dim TRows As Long, shCA As Worksheet
  
  Set shCA = Worksheets("Completed Archive")
  TRows = shCA.Range("Completed_Archive[Stack Rank]").cells.count 
  If TRows = 1 Then TRows = TRows + 1
  Intersect(Target.ListObject.DataBodyRange, Target.EntireRow).Copy _
                 shCA.Range("Completed_Archive[Stack Rank]").cells(TRows)
  'the next code line only selects the row to be deleted. If it selects what you need
  'you would only replace `Select` with `Delete` and the code will delete such rows
  Target.EntireRow.Select 'Delete
End Sub

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    completeArchive Target
End Sub

Sub completeArchive(ByVal Target As Range)
    If Target.Cells.CountLarge = 1 Then
        Dim ws As Worksheet: Set ws = Target.Worksheet
        Dim rg As Range
        Set rg = Intersect(Target, ws.Range("Open_Project_Details[Status]"))
        If Not rg Is Nothing Then
            If rg.Value = "Completed" Then
                Set rg = Intersect(ws.Rows(rg.Row), _
                    ws.Range("Open_Project_Details"))
                With ws.Parent.Worksheets("Completed Archive")
                    With .Range("Completed_Archive[Stack Rank]")
                        rg.Copy .Cells(.Rows.Count + 1)
                        rg.Delete
                    End With
                End With
            End If
        End If
    End If
End Sub