VBA代碼基於行列表選擇自動移動指定的單元格

Question

我需要下面的代碼自動將行移動到另一個工作表，具體取決於我在該行下拉列表中選擇的選項，我只希望列A到該行被移動的S，現在它移動整行。請幫忙。

Sub Automatically Move Members() 

Dim Check As Range 

Lastrow = Worksheets("Members to cut & past").UsedRange.Rows.Count 
Lastrow2 = Worksheets("Holds").UsedRange.Rows.Count 
Lastrow3 = Worksheets("Cancellations").UsedRange.Rows.Count 
If Lastrow2 = 1 Then 
Lastrow2 = 0 
Else 
End If 

If Lastrow3 = 1 Then 
Lastrow3 = 0 
Else 
End If 

Do While Application.WorksheetFunction.CountIf(Range("N:N"), "Hold") > 0 Or 
Application.WorksheetFunction.CountIf(Range("N:N"), "Cancelled") > 0 

Set Check = Range("N2:N" & Lastrow) 
For Each Cell In Check 
    If Cell = "Hold" Then 
     Cell.EntireRow.Copy Destination:=Worksheets("Holds").Range("A" &  lastrow2 + 1) 
     Cell.EntireRow.Clear 
     lastrow2 = lastrow2 + 1 
    ElseIf If Cell = "Cancelled" Then 
     Cell.EntireRow.Copy 
     Destination:=Worksheets("Cancellations").Range("A" & lastrow2 + 1) 
     Cell.EntireRow.Clear 
     Lastrow3 = lastrow3 + 1 
    Else: 
End If 
Next 
Loop 

End Sub 

Answer 1

已解決 有沒有辦法讓這段代碼更有效率？

Private Sub Worksheet_SelectionChange(ByVal Target As Range) 
Dim Check As Range 
Dim RowN As Long 

Lastrow = Worksheets("Members to cut & past").UsedRange.Rows.Count 
lastrow2 = Worksheets("Holds").UsedRange.Rows.Count 
lastrow3 = Worksheets("Cancellations").UsedRange.Rows.Count 


Do While Application.WorksheetFunction.CountIf(Range("N:N"), "Hold") > 0 Or Application.WorksheetFunction.CountIf(Range("N:N"), "Cancelled") > 0 
Set Check = Range("N2:N" & Lastrow) 
For Each Cell In Check 
    If Cell = "Hold" Then 
    RowN = Cell.Row() 
     Worksheets("Members to cut & past").Range(Cells(RowN, 1).Address & ":" & Cells(RowN, 14).Address).Copy Destination:=Worksheets("Holds").Range("A" & lastrow2 + 1) 
     Worksheets("Members to cut & past").Range(Cells(RowN, 1).Address & ":" & Cells(RowN, 14).Address).Clear 
     lastrow2 = lastrow2 + 1 
    ElseIf Cell = "Cancelled" Then 
    RowN = Cell.Row() 
     Worksheets("Members to cut & past").Range(Cells(RowN, 1).Address & ":" & Cells(RowN, 14).Address).Copy Destination:=Worksheets("Cancellations").Range("A" & lastrow3 + 1) 
     Worksheets("Members to cut & past").Range(Cells(RowN, 1).Address & ":" & Cells(RowN, 14).Address).Clear 
     lastrow3 = lastrow3 + 1 
    Else: 
    End If 
Next 
Loop 
End Sub