Sub Creer_Fichiers_Classes()
Dim F As Worksheet, classe$, P As Range, i As Variant, s, chemin$, c As Range, w As Worksheet, Q As Range, nom As Name
'---préparation---
Set F = Feuil1 'CodeName
classe = F.DrawingObjects(Application.Caller).Text 'les boutons doivent avoir des noms différents
Set P = F.ListObjects(1).Range 'tableau structuré
P.Sort P(1, 3), xlAscending, P(1, 2), , xlAscending, P(1), xlAscending, Header:=xlYes 'tri sur les classes, les noms de fichiers et les onglets
i = Application.Match(classe, P.Columns(3), 0) 'EQUIV
If IsError(i) Then MsgBox classe & " non trouvée !", 48: Exit Sub
Set P = P(i, 1).Resize(Application.CountIf(P.Columns(3), classe), P.Columns.Count)
If Application.CountIf(P.Columns(5), "OK") <> P.Rows.Count Then MsgBox "Il faut que tous les onglets de " & classe & " soient validés par OK...": Exit Sub
'---création des dossiers s'ils n'existent pas---
s = Split(P(1, 4), "\")
chemin = s(0) & "\" 'lecteur
For i = 1 To UBound(s)
chemin = chemin & s(i) & "\"
If Dir(chemin, vbDirectory) = "" Then MkDir chemin
Next i
'---création des fichiers---
Application.ScreenUpdating = False
Application.DisplayAlerts = False 'si un fichier a déjà été créé
For Each c In P.Columns(1).Cells
Set w = ThisWorkbook.Sheets(CStr(c))
w.Visible = xlSheetVisible 'si la feuille est masquée
If c(1, 2) <> c(0, 2) Then 'compare avec le nom de fichier au-dessus
w.Copy 'crée un nouveau document
Else
w.Copy After:=ActiveSheet 'ajoute la feuille copiée
End If
Set Q = w.UsedRange 'plage copiée
Range(Q.Address) = Q.Value 'copie les valeurs
If c(1, 2) <> c(2, 2) Then 'compare avec le nom de fichier au-dessous
For Each nom In ActiveWorkbook.Names
If Not nom.Name Like "*!Print_Area" Then nom.Delete 'supprime tous les noms définis sauf les zones d'impression
Next nom
Sheets(1).Select '1ère feuille
ActiveWorkbook.SaveAs chemin & c(1, 2), 51 'enregistre avec l'extension .xlsx
ActiveWorkbook.Close False 'ferme le document
End If
Next c
End Sub