当目标列更改为特定文本时，复制部分行

Question

摘要：

当特定文本输入Physician_Orders的第一列时，我需要在同一工作簿中的两张表之间移动数据，从Physician_Orders到DME_Orders。

一些详细信息：

• 每张表都有列A:I
• 当Physician_Orders Column I更改为文本"Rx Received"时，我需要将列A:C中的数据复制到DME_Orders上的列A:C的第一个空行，使Physician Orders上数据保持不变

如果这以两种方式之一发生，我会没事的：

• 在发生变化时立即发生
• 仅在按下按钮时发生

我在SO上尝试了大约五个不同的脚本，但每一个都有错误。我当前的混乱看起来是这样的，这给了我一个错误，"Object required">

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. 您可以使用Offset和Resize根据Target重新调整要复制的范围
3. 关闭事件以避免无限循环和excel实例崩溃。看起来这不会触发无限循环，但这是最佳实践

---

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