Скопировать частичную строку, когда целевой столбец изменен на указанный c текст

Question

Сводка:

У меня есть два листа в одной рабочей книге, между которыми мне нужно переместить данные из Physician_Orders в DME_Orders, когда указанный c текст вводится в столбец I Physician_Orders.

Некоторые детали:

• На каждом листе есть столбцы A: I
• Когда столбец Physician_Orders I заменен на текст " Получено: «Мне нужно скопировать данные в столбцах A: C в первую пустую строку столбцов A: C в DME_Orders, оставив данные по приказам врачей без изменений.

Со мной все будет в порядке, если это произойдет одним из двух способов:

• Произойдет сразу после изменения
• Произойдет только при нажатии кнопки

Я пробовал около пяти различных скриптов, которые я нашел на SO, но я получаю ошибки с каждым из них. Мой текущий беспорядок выглядит так, что выдает ошибку «Требуется объект».

Sub RxRCVD()

    Dim LastRow As Long
    Dim destRng As Range
    Dim KeyCells As Range
    Set KeyCells = Range("I2:I500")

    If Not Application.Intersect(KeyCells, Range(Target.Address)) _
           Is Nothing Then

        If Target.Value = "Rx Received" Then

     Application.ScreenUpdating = False

     With Sheets("DME_Orders")
        Set destRng = .Range("A" & .Cells(.Rows.Count, "A").End(xlUp).Row + 1)

         Sheets("Physician_Orders").Range("A:C" & Target.Address.Row).Copy Destination:=destRng

            .Columns("A:C").AutoFit
     End With
      Application.ScreenUpdating = True
        End If
    End If

End Sub

Answer 1

1. Используйте событие Worksheet_Change для автоматического запуска макроса
2. Вы можете изменить форму диапазона, который хотите скопировать, на основе Target, используя Offset и Resize
3. Отключите события, чтобы избежать бесконечного l oop и вашего случая краха Excel. Не похоже, что это вызовет бесконечность l oop, но это лучшая практика

---

Private Sub Worksheet_Change(ByVal Target As Range)

Dim DME As Worksheet: Set DME = ThisWorkbook.Sheets("DME_Orders")
Dim lr As Long

If Not Intersect(Range("I2:I500"), Target) Is Nothing Then
    If Target.Value = "Rx Received" Then
        Application.EnableEvents = False
        Application.ScreenUpdating = False

            lr = DME.Range("A" & DME.Rows.Count).End(xlUp).Offset(1).Row
            Target.Offset(, -8).Resize(1, 3).Copy
            DME.Range("A" & lr).PasteSpecial xlPasteValues
            DME.Columns("A:C").AutoFit

        Application.EnableEvents = True
        Application.ScreenUpdating = True
    End If
End If

End Sub