J'ai dans un même tableau des données concernant plusieurs régions, indiquées dans une colonne. Comment créer un classeur par région et y recopier les données de cette région ?

sub CreeClasseurs()
 Application.DisplayAlerts = False
 Sdbl
 For Each c In Range("H2", Range("H65000").End(xlUp))
  Range("H2") = c
  Sheets.Add
  Sheets("Feuil1").[A1:F10000].AdvancedFilter Action:=xlFilterCopy, _
    CriteriaRange:=Sheets("Feuil1").[H1:H2], CopyToRange:=[A1], Unique:=False
  ActiveSheet.Copy
  ActiveSheet.Name = c
  ActiveWorkbook.SaveAs Filename:=c
  ActiveWorkbook.Close
  ActiveSheet.Delete
  Sheets("Feuil1").Select
 Next c
 end sub

sub Sdbl()
 Set MonDico = CreateObject("Scripting.Dictionary")
 For Each c In Range([d2], [d65000].End(xlUp))
  temp = txt(c.Value)
  If Not MonDico.Exists(temp) Then MonDico.Add temp, temp
 Next c
 [H2].Resize(MonDico.Count, 1) = Application.Transpose(MonDico.items)
 end sub

Function txt(x)
 For i = 1 To Len(x)
  If Mid(x, i, 1) >= "A" And Mid(x, i, 1) <= "Z" Then
   temp = temp & Mid(x, i, 1)
  End If
 Next i
 txt = temp
 End Function