Vba 错误438对象不支持此属性筛选表复制和粘贴

我不断收到错误438对象不支持此属性

适用于：wb1.SpecialCellsxlCellTypeVisible.Copy

我正在尝试筛选一个表并将其复制粘贴到新的CSV中。我已经申报了工作簿。我也试过sht2。特殊电池以及 wb1.RangeA2:AI222.SpecialCellsxlCellTypeVisible.Copy

我的完整代码如下：

' Filtered Table
Sub Auto_close13()
'
' Macro2 Macro
'
Dim wb1 As Excel.Workbook
Dim wb2 As Excel.Workbook
Set wb2 = Workbooks.Open("C:\Ha.csv")
Set wb1 = Workbooks.Open("C:\1zzThe Betting System.xlsm")

Dim sht1 As Worksheet
Dim sht2 As Worksheet
Dim copyRange As Range

Set sht1 = wb1.Sheets("Sheet1")
Set sht2 = wb2.Sheets("Ha")

With wb1.Sheets("Sheet1")
    Range("AA2").Select
    If Application.WorksheetFunction.CountA(.Cells) <> 0 Then
        lastRow = .Cells.Find(What:="*", _
        After:=.Range("AA2"), _
        Lookat:=xlPart, _
        LookIn:=xlFormulas, _
        SearchOrder:=xlByRows, _
        SearchDirection:=xlPrevious, _
        MatchCase:=False).Row
    Else
        lastRow = 1
    End If
End With

''Workbooks("1zzThe Betting System.xlsm").Activate
''sht1.Activate
sht1.Range("AA2").Select
sht1.ListObjects.Add(xlSrcRange, , xlYes).Name = _
"Table1"
sht1.Range("Table1[#All]").Select
sht1.ListObjects("Table1").Range.AutoFilter Field:=9, Criteria1:= _
    ">=-1000000000000", Operator:=xlAnd, Criteria2:="<=1000000000000000"

''sht1.Activate
Application.DisplayAlerts = True
wb1.Range("AA2:AI222").SpecialCells(xlCellTypeVisible).Copy
Application.DisplayAlerts = True
Set wb2 = Workbooks.Open("C:\Ha.csv")
Application.DisplayAlerts = True
wb2.Sheets("Ha").Paste
wb2.SaveAs Filename:= _
"C:\Ha.csv", FileFormat:= _
xlCSV, CreateBackup:=False

Workbooks("Ha.csv").Close
''wb1.Close

End Sub  

您已经在代码的开头设置了所有Worobook和WORKEM对象，因此您可以只使用这些对象。比如，Sht1 Sht2等等

可以使用ListObject设置表

注意：您的错误是因为您的复制行中缺少工作表对象：

wb1.Range("AA2:AI222").SpecialCells(xlCellTypeVisible).Copy

如上@Jean-Pierre Oosthuizen commnet所述

请参见下面稍微修改的代码：

Dim LastRow As Long
Dim Tbl1 As ListObject

Set Sht1 = wb1.Sheets("Sheet1")
Set Sht2 = wb2.Sheets("Ha")
With Sht1
    If Application.WorksheetFunction.CountA(.Cells) <> 0 Then
        LastRow = .Cells.Find(What:="*", _
        After:=.Range("AA2"), _
        Lookat:=xlPart, _
        LookIn:=xlFormulas, _
        SearchOrder:=xlByRows, _
        SearchDirection:=xlPrevious, _
        MatchCase:=False).Row
    Else
        LastRow = 1
    End If
End With

Sht1.Range("AA2").Select
Set Tbl1 = Sht1.ListObjects.Add(xlSrcRange, , xlYes)  ' <-- use ListObject to Set the Table

With Tbl1
    .Name = "Table1"
    .Range.AutoFilter Field:=9, Criteria1:= _
            ">=-1000000000000", Operator:=xlAnd, Criteria2:="<=1000000000000000"
End With

Application.DisplayAlerts = True

' Copy >> Paste in 1 line
Sht1.Range("AA2:AI222").SpecialCells(xlCellTypeVisible).Copy Destination:=Sht2.Range("AA2")

wb2.SaveAs Filename:="C:\Ha.csv", FileFormat:=xlCSV, CreateBackup:=False
wb2.Close SaveChanges:=False

---

问题是您没有引用要从中复制的图纸。尝试使用sht1.SpecialCellsxlCellTypeVisible.Copy或wb1.SheetsSheet1.SpecialCellsxlCellTypeVisible.Copy