Sub test()
Dim BD As Object 'déclare la variable BD (onglet BD)
Dim DL As Integer 'déclare la variable DL (Dernièr Ligne)
Dim PL As Range 'déclare la variable PL (PLage)
Dim CEL As Range 'déclare la variable CEL (CELlule)
Dim D As Object 'déclare la variable D (Dictionnaire)
Dim TMP As Variant 'déclare la variable TMP (Tableau TeMPoraire)
Dim I As Byte 'déclare la variable I (Incrément)
Dim O As Object 'déclare la variable O (Onglet)
Dim PLV As Range 'déclare la variable PLV (PLage Visible)
Application.DisplayAlerts = False 'empêche les message Excel
Application.ScreenUpdating = False 'masque les rafraîchissements d'écran
Set BD = Sheets("BD") 'définit'longlet BD
DL = BD.Cells(Application.Rows.Count, 1).End(xlUp).Row 'définit la dernière ligne éditée DL de la colonne 1 (=A) de l'onglet BD
Set PL = BD.Range("A2:A" & DL) 'définit la plage PL
Set D = CreateObject("Scripting.Dictionary") 'définit le dictionnaire D
For Each CEL In PL 'boucle surt toutes les cellules CEL de la plage PL
D(CEL.Value) = "" 'alimente le dictionnaire D
Next CEL 'prochaine cellule de la boucle
TMP = D.keys 'récupère dans le tableau temporaire TMP la liste des élément du dictionnaire D sans doublon
For I = 0 To UBound(TMP) 'boucle sur tous les éléments uniques du tableau temporaire TMP
On Error Resume Next 'gestion ds erreurs (en cas d'erreur passe à la ligne suivante)
Sheets(TMP(I)).Delete 'supprime l'onglet dont le nom est égal à TMP(I) (génère une erreur si cet onglet n'existe pas)
On Error GoTo 0 'annule la gestion des erreurs
Sheets("modèle").Copy After:=Sheets(Sheets.Count) 'copie le modèle en dernière position
ActiveSheet.Name = TMP(I) 'renomme le modèle avec la valeur de TMP(I) comme nom
Set O = ActiveSheet 'définit l'oneglet O
BD.Range("A1").AutoFilter Field:=1, Criteria1:=TMP(I) 'filtre la colonne 1 (=A) de l'onglet BD avec TMP(I) comme critère
BD.Range("A1").AutoFilter Field:=3, Criteria1:="compta" 'filtre la colonne 3 (=C) de l'onglet BD avec "compta" comme critère
On Error Resume Next 'gestion ds erreurs (en cas d'erreur passe à la ligne suivante)
Set PLV = PL.Resize(, 4).SpecialCells(xlCellTypeVisible) 'définit la plage PLV (génère une erreur si aucune cellule visible)
If Err <> 0 Then Err.Clear: GoTo sec 'si une erreur a été générée, efface l'erreur, va à l'étiquette "sec"
PLV.Copy O.Range("A2") 'copy la plage PLV et la colle dans la cellule A2 de l'onglet O
sec: 'étiquette
On Error GoTo 0 'annule la gestion des erreurs
BD.Range("A1").AutoFilter Field:=3, Criteria1:="secretariat" 'filtre la colonne 3 (=C) de l'onglet BD avec "secretariat" comme critère
On Error Resume Next 'gestion ds erreurs (en cas d'erreur passe à la ligne suivante)
Set PLV = PL.Resize(, 4).SpecialCells(xlCellTypeVisible) 'définit la plage PLV (génère une erreur si aucune cellule visible)
If Err <> 0 Then Err.Clear: GoTo edu 'si une erreur a été générée, efface l'erreur, va à l'étiquette "edu"
PLV.Copy O.Range("A22") 'copy la plage PLV et la colle dans la cellule A22 de l'onglet O
edu: 'étiquette
On Error GoTo 0 'annule la gestion des erreurs
BD.Range("A1").AutoFilter Field:=3, Criteria1:="educ" 'filtre la colonne 3 (=C) de l'onglet BD avec "educ" comme critère
On Error Resume Next 'gestion ds erreurs (en cas d'erreur passe à la ligne suivante)
Set PLV = PL.Resize(, 4).SpecialCells(xlCellTypeVisible) 'définit la plage PLV (génère une erreur si aucune cellule visible)
If Err <> 0 Then Err.Clear: GoTo suite 'si une erreur a été générée, efface l'erreur, va à l'étiquette "suite"
PLV.Copy O.Range("A42") 'copy la plage PLV et la colle dans la cellule A42 de l'onglet O
suite: 'étiquette
On Error GoTo 0 'annule la gestion des erreurs
BD.Range("A1").AutoFilter 'supprime le filtre automatique
Next I 'prochaine valeur unique de la boucle
Application.DisplayAlerts = True 'permet les message Excel
Application.ScreenUpdating = True 'affiche les rafraîchissements d'écran
End Sub