自动将表格中的行复制到新工作表

时间:2018-11-13 00:45:59

标签: excel vba sorting copy

我正在尝试将auto-copy中特定的rows从一个Table到另一个worksheet。下面是我的代码。前半部分根据输入到worksheet中的值来隐藏/取消隐藏特定的Columns。当向Column B输入指定值时,后半部分旨在跨特定的rows复制。

当主Column Bworksheet而不是Range时,我可以使它工作。这是我在尝试格式化为Table时的尝试。

Table

错误是:

Option Explicit

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
    '****************
    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.ListObjects(1).DataBodyRange.ClearContents

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

    Dim rngToCopy As Range
    .AutoFilter field:=1, Criteria1:="Change of Numbers"
    Set rngToCopy = Intersect(.SpecialCells(xlCellTypeVisible), sht1.Range("A:F, BL:BO"))
    Debug.Print rngToCopy.Address
    rngToCopy.Copy Destination:=sht2.Cells(4, "B")
    .Parent.AutoFilterMode = False

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

0 个答案:

没有答案