スキルアップ・問題解決なら、モーグにおまかせ！

チャットGTPで下記の条件でコードを取得しましたが、何も転記されません。
お力をお貸しください。よろしくお願い致します。
 
学校　学年　組    児童名(全角表示用)　お試し申込日　解約年月　のフィールドの表が「加工」というシートにあります
学校がA1 のセルに入っている場合下の３つの学校をそれぞれオートフィルターで抽出し、それぞれすでにある同じ名前のシート名のA4のセル以降にVBAで転記してください
A小学校
B小学校
C小学校

　Sub データ転記()
    Dim 学校 As String
    Dim 転記元 As Worksheet
    Dim 転記先 As Worksheet
    Dim 最終行 As Long
    Dim 抽出範囲 As Range
    
    学校 = ThisWorkbook.Sheets("加工").Range("A1").Value
    
    Set 転記元 = ThisWorkbook.Sheets("加工")
    
    ' A小学校のデータを転記
    If 学校 = "A小学校" Then
        Set 転記先 = ThisWorkbook.Sheets("A小学校")
        
        ' 抽出範囲を指定
        Set 抽出範囲 = 転記元.Range("A1:F" & 転記元.Cells(Rows.Count, 1).End(xlUp).Row)
        
        ' オートフィルターを設定してデータを転記
        抽出範囲.AutoFilter Field:=1, Criteria1:="A小学校"
        抽出範囲.SpecialCells(xlCellTypeVisible).Copy 転記先.Range("A4")
        
        ' オートフィルターを解除
        転記元.AutoFilterMode = False
    End If
    
    ' B小学校のデータを転記
    If 学校 = "B小学校" Then
        Set 転記先 = ThisWorkbook.Sheets("B小学校")
        
        ' 抽出範囲を指定
        Set 抽出範囲 = 転記元.Range("A1:F" & 転記元.Cells(Rows.Count, 1).End(xlUp).Row)
        
        ' オートフィルターを設定してデータを転記
        抽出範囲.AutoFilter Field:=1, Criteria1:="B小学校"
        抽出範囲.SpecialCells(xlCellTypeVisible).Copy 転記先.Range("A4")
        
        ' オートフィルターを解除
        転記元.AutoFilterMode = False
    End If
    
    ' C小学校のデータを転記
    If 学校 = "C小学校" Then
        Set 転記先 = ThisWorkbook.Sheets("C小学校")
        
        ' 抽出範囲を指定
        Set 抽出範囲 = 転記元.Range("A1:F" & 転記元.Cells(Rows.Count, 1).End(xlUp).Row)
        

        ' オートフィルターを設定してデータを転記
        抽出範囲.AutoFilter Field:=1, Criteria1:="C小学校"
        抽出範囲.SpecialCells(xlCellTypeVisible).Copy 転記先.Range("A4")
        
        ' オートフィルターを解除
        転記元.AutoFilterMode = False
    End If
End Sub

チャットGTPが流行っているようですね。
お答えする前に、参考までにお聞きします。
コードとデータの概要、それから困っている点を書いて、
それに質問することはできないですか？
 
確認ですが、"加工"シートですか、そのレイアウトを
行番号、列番号が明確にわかるように提示して下さい。（最初の数行で結構）
# 記入した部分を選択し、「コード」ボタンを押してもらって投稿されると、
# レイアウトが崩れにくいと思います。
そして、どのような確認をされたのかも書いて貰えますか？

simple様
早速のお返事ありがとうございます。
各学校のデータを抽出し、学校ごとのシートに転記したいです。
転記先のシートはフォーマットをすでに作成しているので各シートのA4に張り付けたいです。
下記のコードではプログラムは動くのですが何も転記されないです。
BVA初心者で、原因がわからず困っております。
 
 

くみこ さんの引用:
チャットGTPで下記の条件でコードを取得しましたが、何も転記されません。
お力をお貸しください。よろしくお願い致します。
 

A1　　A2　　A3　　A4　　　　　　　　　A5　　　　　A6
学校　学年　組	児童名(全角表示用)　お試し申込日　解約年月　

のフィールドの表が「加工」というシートにあります　
学校がA1 のセルに入っている場合下の３つの学校をそれぞれオートフィルターで抽出し、それぞれすでにある同じ名前のシート名のA4のセル以降にVBAで転記してください
 

A列の2行目以降に学校名が入っています。学校名は下記の3つのみです

A小学校
B小学校
C小学校

　Sub データ転記()
    Dim 学校 As String
    Dim 転記元 As Worksheet
    Dim 転記先 As Worksheet
    Dim 最終行 As Long
    Dim 抽出範囲 As Range
    
    学校 = ThisWorkbook.Sheets("加工").Range("A1").Value
    
    Set 転記元 = ThisWorkbook.Sheets("加工")
    
    ' A小学校のデータを転記
    If 学校 = "A小学校" Then
        Set 転記先 = ThisWorkbook.Sheets("A小学校")
        
        ' 抽出範囲を指定
        Set 抽出範囲 = 転記元.Range("A1:F" & 転記元.Cells(Rows.Count, 1).End(xlUp).Row)
        
        ' オートフィルターを設定してデータを転記
        抽出範囲.AutoFilter Field:=1, Criteria1:="A小学校"
        抽出範囲.SpecialCells(xlCellTypeVisible).Copy 転記先.Range("A4")
        
        ' オートフィルターを解除
        転記元.AutoFilterMode = False
    End If
    
    ' B小学校のデータを転記
    If 学校 = "B小学校" Then
        Set 転記先 = ThisWorkbook.Sheets("B小学校")
        
        ' 抽出範囲を指定
        Set 抽出範囲 = 転記元.Range("A1:F" & 転記元.Cells(Rows.Count, 1).End(xlUp).Row)
        
        ' オートフィルターを設定してデータを転記
        抽出範囲.AutoFilter Field:=1, Criteria1:="B小学校"
        抽出範囲.SpecialCells(xlCellTypeVisible).Copy 転記先.Range("A4")
        
        ' オートフィルターを解除
        転記元.AutoFilterMode = False
    End If
    
    ' C小学校のデータを転記
    If 学校 = "C小学校" Then
        Set 転記先 = ThisWorkbook.Sheets("C小学校")
        
        ' 抽出範囲を指定
        Set 抽出範囲 = 転記元.Range("A1:F" & 転記元.Cells(Rows.Count, 1).End(xlUp).Row)
        

        ' オートフィルターを設定してデータを転記
        抽出範囲.AutoFilter Field:=1, Criteria1:="C小学校"
        抽出範囲.SpecialCells(xlCellTypeVisible).Copy 転記先.Range("A4")
        
        ' オートフィルターを解除
        転記元.AutoFilterMode = False
    End If
End Sub

学校 = ThisWorkbook.Sheets("加工").Range("A1").Value
で得られる学校という変数は常に、見出しの"学校"という文字列なので、
それで抽出できるのは見出し行だけでしょう。

というより、どのIF文も成立しませんから、フィルタすら実行できないと思います。
ステップ実行すればすぐに分かることです。
ちょっと出かけますので、どなたか別のかたからの回答をお待ちください。

>チャットGTP
を使って、得られた答えが、意図したものと違う場合、
多分、質問の仕方に問題がると思います。
  
他人（チャットGTPを含む）に頼らず、手作業でできるならば、
その操作をマクロの記録でコード作成した方が、意図したものに近いコードが作成できると思います。
  
そのコードを理解し、アレンジすることから始めたら如何でしょう。
  
シートのレイアウトを説明したいるが、何処か違っているような気がします。
 

引用:

A1　　A2　　A3　　A4　　　　　　　　　A5　　　　　A6
学校　学年　組    児童名(全角表示用)　お試し申込日　解約年月　
のフィールドの表が「加工」というシートにあります　

参考コードを載せます。
 
意図するものと違うところがあると思います。
自分で修正してください。
 

Option Explicit

Sub 学校抽出()
'
Dim 転記元 As Worksheet
Dim 転記先 As Worksheet
Dim 学校, 抽出範囲 As Range
Dim GIndex As Long

    学校 = Array("A小学校", "B小学校", "C小学校")
    
    Set 転記元 = ThisWorkbook.Sheets("加工")
    
    Set 抽出範囲 = 転記元.Range("A1").CurrentRegion
    抽出範囲.AutoFilter
    
    With 抽出範囲
        For GIndex = LBound(学校) To UBound(学校)
            Set 転記先 = ThisWorkbook.Sheets(学校(GIndex))
            転記先.Range("A4").Resize(抽出範囲.Rows.Count, 抽出範囲.Columns.Count).ClearContents
            .AutoFilter Field:=1, Criteria1:=学校(GIndex)
            .CurrentRegion.Copy Destination:=転記先.Range("A4")
        Next
        .AutoFilter
    End With
    Set 抽出範囲 = Nothing
    Set 転記先 = Nothing
    Set 転記元 = Nothing
    
End Sub

助言
 
前レスで
>他人（チャットGTPを含む）に頼らず、
と書きかしたが、
 
回答者（チャットGTPを含む）は、あなたの下請けではありません。
質問の仕方（説明不足も含めて）によって、
解釈が異なることがあります。
人間ならば、おかしなとこrは、質問するかもしれません。
チャットGPTは、おかしなところがあっても質問せずに勝手に解釈して回答します。
 
他人から貰ったコード（ＷＥＢ掲載を含む）を
そのまま流用（試験で言えば、カンニングと同じ行為）しても、
その背景まではわかりません。
 
その後、運用変更により、コードを変更する事態が生じた時、
最初から同じことをしないといけません。
変更が生じても、他人は助けてくれません。
説明不足を含め、変更が生じた時、自分で変更することを想定して、
他人から貰ったコードは、全て理解することが重要なことです。
考え方まで理解しましょう。わからなれ質問すればよい。
 

助言ありがとうございます。
無事できました！