Sub CopierAvecFiltre()
Dim i&, Plg, F As Worksheet
Application.ScreenUpdating = False
'On récupère les données dans un tableau en mémoire (gain de temps)
'de la ligne cellule ligne 3 colonne 1
'à la cellule dernière ligne remplie de la colonne 1 décalée de 40 colonnes
With Sheets("SYNTHESE_ANNUELLE")
Plg = .Range(.Cells(3, 1), .Cells(3, 1).End(xlDown).Offset(0, 40)).Value
End With
'Pour les colonnes de 1 à 7
For i = 1 To 7
'Si il y a une erreur on saute la ligne
On Error Resume Next
'on dit que f est égal à la feuille qui porte le nom de la cellule
'ligne 2 de notre tableau mémoire colonne i
'Si la feuille n'éxiste pas on a une erreur
Set F = Sheets(Plg(2, i))
'Si il y a une erreur on l'annule
On Error GoTo 0
'Si F n'est égal à rien, donc si la feuille n'éxiste pas
'On la crée
If F Is Nothing Then Sheets.Add(After:=Sheets(i)).Name = Plg(2, i)
'Avec la feuille
With Sheets(Plg(2, i))
'on supprime toute les données
.Cells.ClearContents
'On colle le tableau mémoire
.Cells(1, 1).Resize(UBound(Plg, 1), UBound(Plg, 2)) = Plg
'On tri le tableau sur la colonne i (Voir resize dans l'aide)
.UsedRange.Offset(2, 0).Resize(.UsedRange.Rows.Count - 2, .UsedRange.Columns.Count).Sort _
Key1:=.Cells(2, i), Order1:=xlAscending, Header:=xlGuess, Orientation:=xlTopToBottom
'Mise au format % des colonnes Z à AM
.Range(.Cells(3, 26), .Cells(.UsedRange.Rows.Count, 40)).NumberFormat = "0%"
'On ajuste toutes les colonnes
.Columns.AutoFit
'On supprime la premiere ligne du tableau
Range("A1:AO1").Select
Selection.Delete Shift:=xlUp
Range("A1").Select
'Fin de l'utilisation de la feuille
End With
'on dit que F n'est rien (préparation du prochain passage)
Set F = Nothing
'Prochaibne colonne a traiter
Next i
'Activation de la feuille SYNTHESE_ANNUELLE (pour faire beau
Sheets("SYNTHESE_ANNUELLE").Activate
Application.ScreenUpdating = True
'Boite de message de fin de traitement (si non, pour peu de données,on peux penser quer rien ne s'est passé :) )
MsgBox "Export terminé"
End Sub