复制表但不是Range Excel VBA时出错

Question

我有一个工作script是auto-copies具体的cells从主Sheet到二级Sheet.script如果将Master设置为a range但在转换为a时返回错误,则此方法正常table.

脚本:

Option Explicit

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

    Set sht1 = Worksheets("SHIFT LOG")
    Set sht2 = Worksheets("FAULTS RAISED")

    sht2.UsedRange.ClearContents

    With Intersect(sht1.Columns("B:BP"), sht1.UsedRange)
        .Cells.EntireColumn.Hidden = False ' unhide columns
        If .Parent.AutoFilterMode Then .Parent.AutoFilterMode = False
        'within B:BP, column B is the first column
        .AutoFilter field:=1, Criteria1:="Faults Raised"
        'within B:BP, Columns B:C, AC:AE, BP are referenced as .Columns A:B, AB:AD, BO
        .Range("A:B, AB:AD, BO:BO").Copy Destination:=sht2.Cells(4, "B")
        .Parent.AutoFilterMode = False

        'no need to delete what was never there
        'within B:BP, Columns C:AA, AE:BN, BP are referenced as .Columns B:Z, AD:BM
        .Range("B:Z").EntireColumn.Hidden = True ' hide columns
        .Range("AD:BM").EntireColumn.Hidden = True ' hide columns
    End With
End Sub

我试图改变Range对Table整个script(见下文).但它在以下行返回错误.

Option Explicit

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

    Set sht1 = Worksheets("SHIFT LOG")
    Set sht2 = Worksheets("FAULTS RAISED")

    sht2.UsedTable.ClearContents

    With Intersect(sht1.Columns("B:BP"), sht1.UsedTable)
        .Cells.EntireColumn.Hidden = False ' unhide columns
        If .Parent.AutoFilterMode Then .Parent.AutoFilterMode = False
        'within B:BP, column B is the first column
        .AutoFilter field:=1, Criteria1:="Faults Raised"
        'within B:BP, Columns B:C, AC:AE, BP are referenced as .Columns A:B, AB:AD, BO
        .Table("A:B, AB:AD, BO:BO").Copy Destination:=sht2.Cells(4, "B")
        .Parent.AutoFilterMode = False

        'no need to delete what was never there
        'within B:BP, Columns C:AA, AE:BN, BP are referenced as .Columns B:Z, AD:BM
        .Table("B:Z").EntireColumn.Hidden = True ' hide columns
        .Table("AD:BM").EntireColumn.Hidden = True ' hide columns
    End With
End Sub

.AutoFilter field:=1, Criteria1:="Faults Raised"

错误是:运行时错误'1004':对象'Range'的方法'Autofilter'失败

Answer 1

没有.UsedTable范围这样的东西.为了只关注表格及其中的数据,您应该使用ListObject和.DataBodyRange属性.

这是从ListObject获取数据的基本思想.

Sub test()

Debug.Print ActiveSheet.ListObjects(1).DataBodyRange.Address

End Sub

这是您的脚本更改为包括以上内容:

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

    Set sht1 = Worksheets("SHIFT LOG")
    Set sht2 = Worksheets("FAULTS RAISED")

    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
        'within B:BP, column B is the first column
        .AutoFilter field:=1, Criteria1:="Faults Raised"
        'within B:BP, Columns B:C, AC:AE, BP are referenced as .Columns A:B, AB:AD, BO
        Dim rngToCopy As Range
        Set rngToCopy = Intersect(.SpecialCells(xlCellTypeVisible), sht1.Range("A:B, AB:AD, BO:BO"))
        Debug.Print rngToCopy.Address
        rngToCopy.Copy Destination:=sht2.Cells(4, "B")
        .Parent.AutoFilterMode = False

        'no need to delete what was never there
        'within B:BP, Columns C:AA, AE:BN, BP are referenced as .Columns B:Z, AD:BM
        .Range("B:Z").EntireColumn.Hidden = True ' hide columns
        .Range("AD:BM").EntireColumn.Hidden = True ' hide columns
    End With
End Sub