Код 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