前提・実現したいこと

以前、表題のことを実現するために、「該当のソースコード」の通り作ったのですが
どこかが抜け落ちてしまったため、抽出に失敗します・・・
A列には人物名があり、その人物のデータがＢ列以降に行で並んでいます。
それを、人物名で抽出し、新規シートを作り、転記して最後にその人物名にシート名を変更するという流れです。

発生している問題・エラーメッセージ

ここを変えろと出ます・・・

'変数の名前に変更
       ActiveSheet.Name = SheetNames

実際のシートを見ると、オートフィルタがうまくいっておらず、人物名でフィルタできていないので
見出し列だけが表示されている状態で止まっています。

該当のソースコード

Sub TEST4()
   'リストを、配列に格納
   Dim Data
   With Worksheets("Sheet1")
       Data = .Range(.Range("A1"), .Range("A1").End(xlDown))
   End With
   '重複しないリスト分ループ
   For i = 1 To UBound(Data, 1)
       '支店を、フィルタする
       Worksheets("Sheet1").Range("B1").AutoFilter 2, Data(i, 1)
            '別シートを追加
       Worksheets.Add
       'フィルタしたデータを、追加したシートに転記
       Worksheets("Sheet1").Range("B1").CurrentRegion.Copy ActiveSheet.Range("A1")
            '持ってきたデータ内B2の値（名前）を変数に格納
       Dim SheetNames
           SheetNames = Range("B2").Value
       '変数の名前に変更
       ActiveSheet.Name = SheetNames
      'フィルタ解除
       Worksheets("Sheet1").Range("B1").AutoFilter
   Next
   End Sub

試したこと

重複しないリストを作成する方法を検索してみたのですが、同じような記述で実現しているサイトが
見つからず、どうしてこれが成功していたのかわからない状態です・・・
これが間違っているのかなぁと思うのですが他の書き方がわからず・・・

Data = .Range(.Range("A1"), .Range("A1").End(xlDown))

補足情報（FW/ツールのバージョンなど）

office Standard 2016

行動規範の内容に同意します

回答1件

Sheet3のレイアウトが分からないので勘で答えます。

VBA
1Worksheets("Sheet3").Range("B1").AutoFilter 1, Data(i, 1)

投稿2021/08/06 09:54

jinoji

総合スコア4585

makurintan_0415

2021/08/10 11:40

おそくなりましたすいません！ご回答ありがとうございます。自分がシート名間違ってましたねすいません・・・そこはオートフィルタでの抽出以外は変更を加えないシートで、Sheet1のままです。 B1には見出しがあり、その下には対象の名称があります。エラー終了したあとに見てみると、対象の場所にフィルタはかかっているのですが抽出条件で抽出されていない、という状態です・・・