excel - 更改单元格时自动将行复制到新工作表excel VBA

Question

我知道这已多次作为问题发布。但我就是不能让它工作，我尝试了很多方法。

我有 code自动复制特定 rows到一个新的sheet当一个特定的 value输入Column B .但这只发生在将宏分配给按钮并手动触发它时。在复制大量行时，这不是很有效。尤其是当您复制数百行而只有最后几行实际更改时。我希望这会在输入该值时自动发生。

所以我的first sheet被称为 MASTER和 second sheet被称为 CON .当Change of Numbers输入到MASTER我想自动复制这些rows成片CON .

这个code下面位于Master Sheet (这是第一个)。这个script用于隐藏/取消隐藏特定 Columns当值输入到 Column B .

主表

Private Sub Worksheet_Change(ByVal Target As Range)

    If Not Intersect(Target, Range("B:B")) Is Nothing Then
        On Error GoTo safe_exit
        Application.EnableEvents = False
        Dim t As Range
        For Each t In Intersect(Target, Range("B:B"))
            Select Case (t.Value)
                Case "Change of Numbers"
                    Columns("B:BP").EntireColumn.Hidden = False
                    Columns("H:BL").EntireColumn.Hidden = True
                    'do nothing
            End Select
        Next t

    End If

safe_exit:
    Application.EnableEvents = True
End Sub

以下 script位于 sheet CON (这是第二张纸)。这个 script习惯于 auto-copy rows在哪里 X输入 Column A在 Master sheet .但是，我必须将此宏分配给此工作表上的按钮。然后在每次触发宏时抓取所有指定的行。

CON 表

Option Explicit

Sub FilterAndCopy()
    Dim sht1 As Worksheet, sht2 As Worksheet

    Set sht1 = Sheets("MASTER")
    Set sht2 = Sheets("CON")

    sht2.UsedRange.ClearContents

    With Intersect(sht1.Columns("B:BP"), sht1.UsedRange)
        .Cells.EntireColumn.Hidden = False ' unhide columns
        If .Parent.AutoFilterMode Then .Parent.AutoFilterMode = False

        .AutoFilter field:=1, Criteria1:="Change of Numbers"

        .Range("A:F, BL:BO").Copy Destination:=sht2.Cells(2, "B")
        .Parent.AutoFilterMode = False

        .Range("H:BK").EntireColumn.Hidden = True ' hide columns
    End With
End Sub

但是如果不手动运行脚本，这仍然不起作用。

Answer 1

您的代码没有监视任何事件的发生。您想要的特定事件是 Worksheet_Change()事件，这是我在您提供的第二个代码片段中看到的。

所以，你可以通过这两种方式。一，将整个代码复制并粘贴到此事件中，或者二(通常是首选)是在事件处理程序中调用 sub。

但是，为了让工作表监视更改事件，您需要将其放入工作表的代码模块中。在 VBE 中，您将看到它为 Sheet1 , Sheet2 ， ETC。

我的建议，把你的Sub FilterAndCopy()在标准模块中。那么在 Sheet1的代码模块 ， 添加:

Private Sub Worksheet_Change(ByVal Target As Range)

    On Error GoTo ErrHandler

    'Test if criteria is met
    If Intersect(Target, Columns("A")) Is Nothing Then
        Exit Sub
    ElseIf Target.Value = "mySpecificValue" Then
        Application.EnableEvents = False
        FilterAndCopy

        Dim t As Range
        For Each t In Intersect(Target, Range("a:a"))
            Select Case UCase(t.Value)
                Case "X"
                    Columns("B:C").EntireColumn.Hidden = True
                    Columns("D:E").EntireColumn.Hidden = False
                Case "Y"
                    Columns("B:C").EntireColumn.Hidden = False
                    Columns("D:E").EntireColumn.Hidden = True
                Case Else
                    'do nothing
            End Select
        Next t

    End If

ErrHandler:

    If Err.Number <> 0 Then
        Rem: Optional - Error message and/or err recovery
    End If

    Application.EnableEvents = True

End Sub