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

我试图从一张表复制行到另一个基于列N是否包含大于0.9的数字。

当我用sub test（）replace第一行并从vbaeditor运行macros时，该公式工作，但是我无法通过在工作表原始数据中发生的变化来使其工作。

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将工作，我需要execpt我只需要它现在不复制以前复制的行。

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。 确保sub不是私人的，所以：

子testing（）
   '你的代码在这里
结束小组

然后在VBA编辑器中，您可以转到原始数据工作表，然后从下拉列表中select“工作表变更”function，然后从那里调用您的testing子。 所以它看起来像：

 私人小组Worksheet_Change（BYVAL目标作为范围）
  调用Module1.Test
结束小组 

这将调用原始数据工作表中的任何更改的子testing。 这可能比你想要的要多。 如果您只想在调用“子testing”之前检查某个列是否已更改，则可以将以下代码添加到“工作表更改”过程。 在调用子程序之前，先testing被更改的单元格是否在一定范围内。 在这种情况下，我做了范围列N.

私人小组Worksheet_Change（BYVAL目标作为范围）

  昏暗的范围
  设置r =相交（Target，Me.Range（“N：N”））
  如果r不是那么退出子

  调用Module1.Test

结束小组