excel - 复制表格时出错，但复制范围时出错 Excel VBA

Question

我有一个工作script那auto-copies具体cells来自大师Sheet到中学Sheet 。这个script如果主设备设置为 range 则工作正常但转换为 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 Range 这样的东西。为了仅关注表格及其中的数据，您应该使用 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