复制表格出错但复制范围正常 Excel VBA

Question

复制表格出错但复制范围正常 Excel VBA

3

我有一个工作的脚本，它可以将主要表格中的特定单元格自动复制到次要表格中。如果将主要内容设置为范围，则此脚本效果很好，但如果转换为表格，则会返回错误。

脚本：

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。但是在以下行上返回错误。

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' 失败。

- Chopin

1

一个表格是一个ListObject。你能具体说明一下你尝试如何修改这段代码吗？可以提供一小段代码片段以及抛出的错误信息。 - BigBen

@BigBen，我刚刚把所有标记为Range的东西都换成了Table。错误出现在 FilterandCopy 行。 - Chopin

对象模型中没有 Table 对象 - 使用 ListObject 及其属性。 - BigBen

你想使用结构引用来代替同一列的范围引用吗？ - Mark Fitzgerald

你得到了什么错误？不确定在这种情况下是否相关，但是根据我的经验，在命名范围与表/列表对象相结合时可能会发生奇怪的事情。 - Egalth

显示剩余6条评论

1个回答

网页内容由stack overflow 提供, 点击上面的

可以查看英文原文，
原文链接

- rohrl77 · Accepted Answer

没有所谓的.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