自动复制到另一张纸的最后一行

Question

我正在尝试根据 N 列是否包含大于 0.9 的数字，将行从一张纸复制到另一张纸。

当我用 sub test() 替换第一行并从 vbaeditor 运行宏时，该公式有效，但是我无法通过工作表原始数据中发生的更改来使其工作。

Private Sub Worksheet_Calculate()
Dim i As Long
Dim lr1 As Long, lr2 As Long
Dim Delta As String
Dim wks1 As Worksheet, wks2 As Worksheet

Set wks1 = ActiveSheet
Set wks2 = Worksheets("Charges") 'change to suit
lr1 = wks1.Cells(Rows.Count, "N").End(xlUp).Row

For i = 2 To lr1

        lr2 = wks2.Cells(Rows.Count, "A").End(xlUp).Row + 1
        wks1.Cells(i, "N").EntireRow.Copy Destination:=wks2.Cells(lr2, "A")

Next i
End Sub

上面的工作表 calcualte 可以满足我的需要，除了我现在只需要它来不复制以前复制的行。

Answer 1

这必须插入到其列 N 正在更新的工作表的工作表代码区域中：

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim i As Long
    Dim lr1 As Long, lr2 As Long
    Dim Delta As Variant'****************EDIT************
    Dim wks1 As Worksheet, wks2 As Worksheet
    Dim rINT As Range
    Set rINT = Intersect(Target, Range("N:N"))
    If rINT Is Nothing Then Exit Sub
    Set wks1 = ActiveSheet
    Set wks2 = Worksheets("Charges") 'change to suit
    lr1 = wks1.Cells(Rows.Count, "N").End(xlUp).Row

    For i = 2 To lr1
        Delta = wks1.Cells(i, "N").Value
        If Delta > 0.9 Then
            lr2 = wks2.Cells(Rows.Count, "A").End(xlUp).Row + 1
            wks1.Cells(i, "N").EntireRow.Copy Destination:=wks2.Cells(lr2, "A")
        End If
    Next i

    MsgBox "Macro is Done, Thank you for waiting", vbInformation
End Sub

Answer 2

这样做的一种方法是将 sub 重命名为 Test 并将其放入模块中。我们称之为Module1。确保子不是私有的，所以：

子测试（） ' 你的代码在这里 结束子

然后在 VBA 编辑器中，您可以转到原始数据工作表并从下拉列表中选择工作表更改功能，然后从那里调用您的测试子。所以它看起来像：

Private Sub Worksheet_Change(ByVal Target As Range)
  调用 Module1.Test
结束子

这将对原始数据工作表中的任何更改调用子测试。这可能比您要找的要多。如果您只想在调用 Sub Test 之前检查某个列是否已更改，您可以将以下代码添加到 Worksheet Change 过程中。这会在调用 sub 之前先测试更改的单元格是否在某个范围内。在这种情况下，我将范围列设为 N。

Private Sub Worksheet_Change(ByVal Target As Range) 调暗作为范围 设置 r = intersect(Target, Me.Range("N:N")) 如果 r 什么都不是，则退出 Sub 调用 Module1.Test 结束子