代码之家 › 专栏 › 技术社区 › Chopin

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

copy vba excel

Chopin · 技术社区 · 6 年前

我知道这个问题已经被贴了很多次了。但我就是不能让它工作,我尝试了很多方法。

code rows 到一个新的 sheet 当一个特定的 value 签订 Column B . 但这只有在将marco分配给按钮并手动触发它时才会发生。当复制多行时,这不是很有效。尤其是当你复制上百行的时候,只有最后几行真正改变了。我希望输入该值时会自动发生这种情况。

first 床单 被称为 MASTER 以及 second 床单 被称为 CON . 什么时候? Change of Numbers 进入我想自动复制这些进入工作表 反对的论点

这个 代码 下面是位于 Master Sheet (这是第一个)。这个 script 用于隐藏/取消隐藏特定的 Columns 输入值时 .

母版纸

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

以下 脚本 床单 反对的论点 (这是第二张纸)。这个习惯于 auto-copy 这个哪里 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

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

2 回复 | 直到 6 年前

K.Dá´á´ Éªs 6 年前

您的代码没有监视任何事件的发生。您想要的特定事件是 Worksheet_Change()

然而,对于 工作表 去观察 ,您需要将其放入工作表的代码模块中。在VBE中,您将看到 Sheet1 , Sheet2 等等。

我的建议是 Sub FilterAndCopy() 在标准模块中。那么 在里面 表一 的代码模块 ,添加:

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

urdearboy 6 年前

如果你的第一个子工程完全按照预期所有你需要做的是 Call 你的潜艇 Worksheet_Change 事件。我只想说清楚,作为你的 工作表\u更改 Column A

Private Sub Worksheet_Change(ByVal Target As Range)

If Intersect(Target, Range("A:A")) Is Nothing Then Exit Sub
Application.EnableEvents = False 'to prevent endless loop
    On Error GoTo Finalize 'to re-enable the events
        FilterAndCopy

Finalize:
    Application.EnableEvents = True
End Sub