Question

我是编码的新手。

我正在尝试使用代码将行移动到不同的工作表，并将完成的行移动到不同的工作。

我遇到问题Sub Worksheet_Change被视为含糊不清的名称，当我尝试将名称更改为Worksheet_ChangeCOMPLETE或WorkSheet_Change3时，我无法正常工作。< / p>

以下是我尝试使用的代码。

我的计划是，我希望已完成的订单（行）移动到我已命名为＆＃34;已完成＆＃34;的新工作簿。当按下一个命令按钮时，它会触发一个宏来插入单词＆＃34; COMPLETE＆＃34;在第13（M）栏中。

这本新工作手册以前是我的工作表2，但我按照另一个论坛的指示将其作为新工作簿。当＆＃34; PARTIAL HOLD＆＃34;我还需要行移动到表3。通过不同的命令按钮插入第13列，然后在第3页＆＃34; RESUME＆＃34;上的命令按钮时返回到第1页。点击。

所有工作簿和工作表都具有相同的列和间距，我只是无法在重命名时获取代码。

我发布的第一组代码用于在按下命令按钮时将行从sheet 1移动到sheet 3，然后是将行移动到新工作簿的代码，这些代码位于{ {1}}在VBA项目下，而不是模块。

第三张是在第3页上，一旦HOLD完成，将行移回Sheet 1。

提前感谢您的帮助。

第1页

sheet 1

第3页

 Private Sub Worksheet_Change(ByVal Target As Range)
      Dim rngDest As Range
      Set rngDest = Sheet3.Range("A5:R5")


      If Not Intersect(Target, Sheet1.Range("M5:M290")) Is Nothing Then

      If UCase(Target) = "PARTIAL HOLD" Then

      Application.EnableEvents = False

      Target.EntireRow.Select
      Selection.Cut
      rngDest.Insert Shift:=xlDown
      Selection.Delete
      Application.EnableEvents = True
      End If
 End If
 End Sub


 Private Sub Worksheet_ChangeCOMPLETE(ByVal Target As Range)


       Dim destWbk As String
       Dim wbk As Workbook
       Dim rngDestCOMPLETE As Range


       destWbk = ThisWorkbook.Names("Completed.xlsx").RefersTo
       destWbk = Replace(destWbk, "=" & Chr(34), "")
       destWbk = Replace(destWbk, Chr(34), "")

       Set wbk = Application.Workbooks(destWbk)

       Set rngDest = wbk.Names("A1:S1").RefersToRange



       If Not Intersect(Target, Sheet1.Range("rngTrigger")) Is Nothing Then

         If UCase(Target) = "COMPLETED" Then

            Application.EnableEvents = False
            Target.EntireRow.Select
            Selection.Cut
            rngDest.Insert Shift:=xlDown
            Selection.Delete
            Application.EnableEvents = True
        End If
      End If
 End Sub

Answer 1

正如我在评论中提到的，你不能重命名这些Subs，但你可以做如下的事情：

Private Sub Worksheet_Change(ByVal Target As Range)
Dim rngDest As Range, rngDest2 As Range, rngDest3 As Range
Dim destWbk As String
Dim wbk As Workbook
     If UCase(Target.Value) = "PARTIAL HOLD" Then
        Set rngDest = Sheet3.Range("A5:R5")
        If Not Intersect(Target, Sheet1.Range("M5:M290")) Is Nothing Then
            Application.EnableEvents = False
            Target.EntireRow.Cut
            rngDest.Insert Shift:=xlDown
            Target.EntireRow.Delete
            Application.EnableEvents = True
        End If
    ElseIf UCase(Target.Value) = "IN PROGRESS" Then
        Set rngDest3 = Sheet1.Range("A5:S5")
        If Not Intersect(Target, Sheet3.Range("M5:M290")) Is Nothing Then
            Application.EnableEvents = False
            Target.EntireRow.Cut
            rngDest3.Insert Shift:=xlDown
            Target.EntireRow.Delete
            Application.EnableEvents = True
        End If
    ElseIf UCase(Target.Value) = "COMPLETED" Then
        destWbk = ThisWorkbook.Names("Completed.xlsx").RefersTo
        destWbk = Replace(destWbk, "=" & Chr(34), "")
        destWbk = Replace(destWbk, Chr(34), "")
        Set wbk = Application.Workbooks(destWbk)
        Set rngDest2 = wbk.Range("A1:S1")
        If Not Intersect(Target, Sheet1.Range("rngTrigger")) Is Nothing Then
             Application.EnableEvents = False
             Target.EntireRow.Cut
             rngDest2.Insert Shift:=xlDown
             Target.EntireRow.Delete
             Application.EnableEvents = True
        End If
    End If
End Sub

重命名Subs用于多次使用，移动行和VBA

1 个答案: