上位の絞り込み＆別シートへ（VBA)

昨日の晩からはまっていたのですが、今なんとか解決。

Sub 上位抽出シート作成()
    Worksheets("Sheet1").Range("A1").AutoFilter Field:=17, Operator:=xlTop10Items
    
    
    '抽出したデータをすべて取得
    Worksheets("Sheet1").Range("A1"). _
          CurrentRegion.SpecialCells(xlVisible).Copy
    'Range("A1").CurrentRegion.SpecialCells(xlTypeVisible).Copy　'こちらだとエラー
    
    '取得したものを使用して上位抽出シート作成
    Worksheets.Add after:=Worksheets(Worksheets.Count)  '末尾にシートを追加
    Worksheets(Worksheets.Count).Name = "上位抽出結果"  '新規追加先のワークシート名を設定
    Worksheets("上位抽出結果").Range("A1").Select
    ActiveSheet.Paste
End Sub

エラーになるケースだとなぜエラーになるのがわからなくてはまってました・・・。
上記のところで
Worksheets("sheet1")とワークシートオブジェクトを
指定してフィルターかけていた場合、その結果に対して操作するときも
Worksheets("sheet1")ときちんとワークシートオブジェクトを指定してあげないとダメ。

withステートメントをつけて書いていくとこういうことを防げそう
＋
きちんとワークシート存在する場合の処理書いていなかったので修正。

Sub 上位抽出シート作成()
    Worksheets("Sheet1").Range("A1").AutoFilter Field:=17, Operator:=xlTop10Items
    
    
    '抽出したデータをすべて取得
    Worksheets("Sheet1").Range("A1"). _
          CurrentRegion.SpecialCells(xlVisible).Copy  '途中に空白列あるとそこまでのみ取得なので注意
    'Range("A1").CurrentRegion.SpecialCells(xlTypeVisible).Copy 'こちらだとエラー
    
    '取得したものを使用して上位抽出シート作成
    
    'ワークシート上位検索シートが存在するか
    '存在する場合のみ新規追加
    Dim ws As Worksheet, flag As Boolean
    Worksheet = False
    For Each ws In Worksheets
        If ws.Name = "上位抽出結果" Then
            flag = True
        End If
    Next ws
    If flag = False Then
        Worksheets.Add after:=Worksheets(Worksheets.Count) '末尾にシートを追加
        Worksheets(Worksheets.Count).Name = "上位抽出結果" '新規追加先のワークシート名を設定
    End If

    '上位抽出結果シートに抽出結果を張り付ける
    With ActiveWorkbook
        .Worksheets("上位抽出結果").Activate      'アクティブシートを上位抽出結果シートに切り替える
        .Worksheets("上位抽出結果").Range("A1").Select
    End With
    ActiveSheet.Paste
End Sub