Автоматическое копирование строк на новый лист при изменении ячейки 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 SHEET

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(), которое я вижу во втором предоставленном вами фрагменте кода.

Итак, вы можете сделать это двумя способами.Во-первых, скопируйте и вставьте весь код в это событие, или два (что обычно предпочтительнее) будет вызывать подпрограмму в обработчике события.

Однако для просмотра Worksheet для события изменения необходимо поместить его в модуль кода рабочего листа.В VBE вы увидите это как Sheet1, Sheet2 и т. Д.

Моя рекомендация, поместите ваш 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

Answer 2

Если ваш первый саб работает точно так, как задумано, все, что вам нужно сделать, это Call саб из вашего Worksheet_Change события.Просто чтобы быть понятным, поскольку ваш макрос Worksheet_Change настроен, он будет вызываться только в том случае, если изменение сделано на 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