Копировать строки без запуска макроса VBA

Question

Есть несколько вопросов, касающихся этой темы, но я немного борюсь.

У меня есть МАСТЕР sheet, в котором хранится различная информация. Я использую Column B, чтобы скрыть / показать других columns. Таким образом, для каждого отдельного значения, введенного в столбце B, будет отображаться соответствующий Columns. например Если X введено в Column B, будет отображаться Col C:F и Col G:I будет скрыто.

Это прекрасно работает, но я хочу автоматически copy идентичные значения из этого листа, чтобы отделить sheets. например возьмите все X's в MASTER и скопируйте в отдельный sheet, который содержит только X's.

Я могу сделать это, но только с помощью macro, который должен быть активирован. Это не очень эффективно, если мне нужно copy множество rows. Особенно, если вы только обновили 1 row, но вам нужно скопировать все.

Я хочу автоматически копировать автоматически, как только будет введено значение. Без необходимости запускать макрос

Это script специфическая скрывается / скрывается columns в MASTER sheet:

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

Поскольку я не могу добавить отдельный Worksheet_Change к этому сценарию для автоматического копирования через него, я немного запутался в том, как это сделать

В настоящее время я использую скрипт ниже. Это копирует соответствующий rows в соответствующий sheet. Но это работает только при срабатывании. Я надеюсь автоматически copy row после заполнения.

@ Гексас, как это?

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

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim rng As Range, sht1 As Worksheet, sht2 As Worksheet

    Set sht1 = Worksheets("MASTER")
    Set sht2 = Worksheets("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 может содержать обе ваши функции. Так как код читается с первой до последней строки, при заказе VBA будет копировать содержимое из вашего второго кода, а затем скрывать столбцы. Код ниже должен работать, предполагая, что все остальное хорошо с. Обратите внимание, что я не могу проверить это и не проверял другие ошибки. Только что изменил заказ.

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim rng As Range, sht1 As Worksheet, sht2 As Worksheet

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

    sht2.UsedRange.ClearContents

    If Not Intersect(Target, Range("B:B")) Is Nothing Then
        On Error GoTo safe_exit
        Application.EnableEvents = False

        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

        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

Answer 2

Фильтр и копирование

Если вы переместите 'Sub' в код листа (Master), вы можете потерять 'sht1' в нем, как вы это делали в 'Private Sub', если не просто добавить строку FilterAndCopy соответствующим образом в 'Private Sub .

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)

    On Error GoTo safe_exit

    ' Something has changed in Column "B"
    If Not Intersect(Target, Range("B:B")) Is Nothing Then

        Application.EnableEvents = False

    ' *******************
        FilterAndCopy ' *
    ' *******************

        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


'****************
Sub FilterAndCopy()

    Dim rng As Range, sht1 As Worksheet, sht2 As Worksheet

    Set sht1 = Worksheets("MASTER")
    Set sht2 = Worksheets("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
'****************