代码之家 › 专栏 › 技术社区 › Chopin

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

range copy vba excel

Chopin · 技术社区 · 6 年前

我有一份工作 script 那个 auto-copies 具体的 cells 从主人那里 Sheet 到第二个 工作表 . 这个 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 在整个

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”失败

1 回复 | 直到 6 年前

rohrl77 6 年前

没有.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