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

Question

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

当我用sub test（）替换第一行并从vbaeditor运行宏时，该公式起作用，但是我无法通过工作表Raw Data中发生的更改来使它起作用。

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

一种方法是将子项重命名为Test并将其放入模块中。 我们称它为Module1。 确保该子项不是私有的，因此：

Sub Test()
  ' your code here
End Sub

然后，在VBA编辑器中，您可以转到“原始数据工作表”并从下拉列表中选择“ WorkSheet Change”功能，然后从此处调用“测试”子项。 因此，它看起来像：

Private Sub Worksheet_Change(ByVal Target As Range)
  Call Module1.Test
End Sub

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

Private Sub Worksheet_Change(ByVal Target As Range)

  Dim r As Range
  Set r = intersect(Target, Me.Range("N:N"))
  If r Is Nothing Then Exit Sub

  Call Module1.Test

End Sub