时间戳

首页 > 解决方案 > 目标列更改为特定文本时复制部分行

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

问题描述

概括：

当特定文本输入到 Physician_Orders 的 I 列时，我在同一个工作簿中有两张表，我需要在从 Physician_Orders 到 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

标签： excelvba

解决方案

  1. 使用Worksheet_Change事件自动触发你的宏
  2. Target您可以使用Offset和重新调整要复制的范围Resize
  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

推荐阅读