Warning: file_get_contents(/data/phpspider/zhask/data//catemap/5/excel/25.json): failed to open stream: No such file or directory in /data/phpspider/zhask/libs/function.php on line 167

Warning: Invalid argument supplied for foreach() in /data/phpspider/zhask/libs/tag.function.php on line 1116

Notice: Undefined index: in /data/phpspider/zhask/libs/function.php on line 180

Warning: array_chunk() expects parameter 1 to be array, null given in /data/phpspider/zhask/libs/function.php on line 181
Excel VBA代码,用于根据行列表选择自动移动行中的指定单元格_Excel_Copy Paste_Worksheet Function_Automatic Updates_Vba - Fatal编程技术网

Excel VBA代码,用于根据行列表选择自动移动行中的指定单元格

Excel VBA代码,用于根据行列表选择自动移动行中的指定单元格,excel,copy-paste,worksheet-function,automatic-updates,vba,Excel,Copy Paste,Worksheet Function,Automatic Updates,Vba,我需要下面的代码自动将一行移动到另一个工作表,具体取决于我在该行下拉列表中选择的选项,我只希望移动该行的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 Las

我需要下面的代码自动将一行移动到另一个工作表,具体取决于我在该行下拉列表中选择的选项,我只希望移动该行的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
解决 有没有办法使这段代码更有效

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