VBA:フィルタをかけて別シートに転記

前提・実現したいこと

VBAで都道府県シートのC列を"東京"の行のみでフィルターをかけ、
その行を別シートにコピーしたいです。

もし、"東京"がなければシートを作らない(=何もしない)処理をしたいです。

以下のコードを実行すると、"東京"がないときは何も起きないのですが、
"東京"がある場合、なぜかシートが２つできてしまい
このシート名は常に使われていますというエラーがでてしまいます。

該当のソースコード

Sub Filter4()
Dim i
 For i = 2 To Worksheets("都道府県").Range("C10000").End(xlUp).Row
 
    If Not Worksheets("都道府県").Range("C" & i) = "東京" Then
    
     GoTo Continue
    
    End If
    
    
    '都道府県を東京でフィルタ
    Worksheets("都道府県").Range("A1").AutoFilter 3, "都道府県"
    'シートを追加
    Worksheets.Add after:=ActiveSheet
    'フィルタしたデータを、別シートに転記
    Worksheets("都道府県").Range("A1").CurrentRegion.Copy ActiveSheet.Range("A1")
    ActiveSheet.Name = "★東京"
    'フィルタを解除
    Worksheets("都道府県").Range("A1").AutoFilter
    
   
Continue:
 Next i
 
End Sub

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

回答1件

ベストアンサー

現状のコードだとC列を1行ずつ見ていって「東京」のセルがある度にフィルターを掛けてシートを追加してシートの名前を変更する状態です。そのため2個目の東京の行があった場合にシートを追加して既にある名前に変更しようとしてエラーになっていると思います。
1行ずつ確認するよりC列に東京があるかを確認するようにして

VBA
1Sub Filter4()
2
3    Dim FoundCell As Range
4    Set FoundCell= Columns(3).Find(What:="東京", LookIn:=xlValues, Lookat:=xlWhole)
5
6    If Not FoundCell Is Nothing Then
7
8        '都道府県を東京でフィルタ
9        Worksheets("都道府県").Range("A1").AutoFilter 3, "都道府県" ←ここは東京？
10        'シートを追加
11        Worksheets.Add after:=ActiveSheet
12        'フィルタしたデータを、別シートに転記
13        Worksheets("都道府県").Range("A1").CurrentRegion.Copy ActiveSheet.Range("A1")
14        ActiveSheet.name = "★東京"
15        'フィルタを解除
16        Worksheets("都道府県").Range("A1").AutoFilter
17
18    End If
19
20End Sub