エラー438オブジェクトはこのプロパティをサポートしていませんフィルタリングされたテーブルのコピーと貼り付け

Question

エラーが続きます438オブジェクトはこのプロパティをサポートしていません。

：wb1.SpecialCells(xlCellTypeVisible).Copy

私はテーブルをフィルタリングし、新しいCSVに貼り付けコピーしようとしています。私はワークブックを宣言しました。私はまた、sht2.Specialcellsを試してみましただけでなく、 wb1.Range("AA2:AI222").SpecialCells(xlCellTypeVisible).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 

Answer 1

あなたは既にSetあなたのコードの初めのすべてのWorobookとWorksheetオブジェクトを、あなただけ使用できるようにこれらのオブジェクト。同様に、Sht1Sht2など...

テーブルを設定するにはListObjectを使用できます。

注：あなたはコピーラインにWorksheetオブジェクトが欠落しているので、あなたのエラーが来る：

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

（上記@ジャン=ピエール・OosthuizenののCommNetで述べたように）

わずかmodifedコードを参照してください。以下のようになります。

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