Переименование Subs для многократного использования, Moving Rows и в VBA

Question

Я новичок в кодировании.

Я пытаюсь использовать код для перемещения строк на разные листы и перемещения завершенных строк на другую работу.

У меня проблема с тем, что Sub Worksheet_Change воспринимается как неоднозначное имя и не работает, когда я пытаюсь изменить имя на что-то вроде Worksheet_ChangeCOMPLETE или WorkSheet_Change3.

Ниже приведены коды, которые я пытаюсь использовать.

Мой план состоит в том, чтобы я хотел, чтобы завершенные заказы (строки) перемещались в новую рабочую книгу, в которой я назвал «ЗАВЕРШЕНО», когда нажата командная кнопка, которая запускает макрос, чтобы вставить слово «ЗАВЕРШЕНО» в столбец 13 ( M).

Эта новая рабочая книга ранее была моим листом 2, но я сделал ее новой рабочей книгой, следуя инструкции другого форума. Мне также нужно, чтобы строки переместились на лист 3, когда «ЧАСТИЧНОЕ УДЕРЖАНИЕ» вставлено в столбец 13 через другую командную кнопку и затем возвращено на лист один, когда нажата командная кнопка на листе 3 «ВОЗОБНОВЛЕНИЕ».

Все рабочие книги и рабочие таблицы имеют одинаковые столбцы и интервалы, я просто не могу заставить работать коды при их переименовании.

Первый набор кодов, который я публикую, предназначен для перемещения строк из sheet 1 в sheet 3 при нажатии кнопки команды, а затем код для перемещения строк в новую книгу. Эти коды находятся в Sheet 1 в VBA. проект, а не модуль.

Третий находится на листе 3 для перемещения строк обратно к sheet 1 после завершения HOLD.

Заранее благодарю за помощь.

ЛИСТ 1

 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

ЛИСТ 3

 Private Sub Worksheet_Change3(ByVal Target As Range)
 Dim rngDest3 As Range
 Set rngDest3 = Sheet1.Range("A5:S5")

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

      If UCase(Target) = "IN PROGRESS" 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