自動復制到另一張紙的最后一行

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