各シートに振り分ける

Sub シートへ振分け()

   '変数宣言
  Dim i As Long
  
    'A列をG列にコピーする
    Range("A:A").Copy Range("G1")
    
    'A列の重複なしリストをG列に作成
    Range("G1").CurrentRegion.RemoveDuplicates 1, xlYes
  
       'リストシートを選択
        With Sheets("リストシート")
        
        '7列目(G列)の2行目から最終行まで(重複がない列）
            For i = 2 To Cells(Rows.Count, 7).End(xlUp).Row
            
                'オートフィルタ7列目(G列)で条件設定は重複がない列）
                .Range("A1").AutoFilter 1, .Cells(i, 7)
                
                'シートを1枚追加する
                Sheets.Add After:=Sheets(Sheets.Count)
                
                '追加シート名は、G列のセルの値(重複がない列）
                ActiveSheet.Name = .Cells(i, 7)
   
               '追加シートの5行目以降にコピー
                .Range("A1").CurrentRegion.Copy Range("A5")

            Next i

        End With
  
   'AutoFilterを解除
   Sheets("リストシート").Range("A1").AutoFilter
   
   'リストシートを選択
   Sheets("リストシート").Select
  
End Sub