Sub ventiler()
Dim x, derlig&, t, i1&, i2&, i
With Worksheets("GL") 'avec la feuille "GL"
Application.ScreenUpdating = False: Application.DisplayAlerts = False 'on fige l'écran et desactive les alertes
For Each x In ThisWorkbook.Worksheets 'pour chaque feuille de calcul de ce classeur
If x.Name <> "GL" Then x.Delete 'si son nom est différent de GL alors on efface la feuille de calcul
Next x
Application.DisplayAlerts = True 'on réactive les messages d'alerte
If .FilterMode Then .ShowAllData 'si un filtre est actif alors on affiche toutes les lignes
derlig = .Cells(.Rows.Count, "a").End(xlUp).Row 'dernière ligne des données
'on trie les huits première colonne selon le critère colonne A (Société)
.Range("a:o").Resize(derlig).Sort key1:=.Range("a1"), order1:=xlAscending, Header:=True
t = .Range("a1:a" & derlig) 'on transfère les valeurs de la colonne A dans ule tableau en mémoire t
'PRINCIPE : comme la colonne A est triée, on va partir de la ligne i1=2 et on va
'incrémenter i2 (à partir de i1) tant que la société est la même que celle de la ligne i1.
'Quand la société de la ligne(i2+1)sera différente de celle de la ligne i1, alors
'on copiera le bloc de lignes i1 à i2 sur une nouvelle feuille
'puis on recommencera la même chose à partir de la ligne i2+1 pour la nouvelle société.
'Un cas particulier est quand i2 est la dernière ligne des données : dans ce cas, il faut copier
'le bloc [i1,i2] mais sortir ensuite de la boucle puisqu'on sera arrivé à la fin des données.
'i1 est la première ligne des données à copier ; i2 sera la dernière ligne à copier
i1 = 2: i2 = i1 't(i1,1) est la société qu'on traite
Do 'boucle sans fin
If i2 = UBound(t) Then 'si i2 est la dernière ligne des données
ThisWorkbook.Worksheets.Add after:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count) 'créer une nouvelle feuille
.Range("1:1").Copy ActiveSheet.Range("1:1") 'copier les en-têtes dela feuille GL vers la nouvelle feuille
.Range(i1 & ":" & i2).Copy ActiveSheet.Range("2:2") 'copier les lignes de i1 à i2 vers la nouvelle feuille
ActiveSheet.Name = t(i1, 1) 'nommer la nouvelle feuille avec le nom idoine
ActiveSheet.Columns("a:o").EntireColumn.AutoFit 'ajuster la largeur des colonnes de la nouvelles feuille
Exit Do 'comme on a atteint la fin des données on sort de la boucle
ElseIf t(i2 + 1, 1) <> t(i2, 1) Then 'la société suivante sera différente de la société en cours
ThisWorkbook.Worksheets.Add after:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count) 'créer une nouvelle feuille
.Range("1:1").Copy ActiveSheet.Range("1:1") 'copier les en-têtes dela feuille GL vers la nouvelle feuille
.Range(i1 & ":" & i2).Copy ActiveSheet.Range("2:2") 'copier les lignes de i1 à i2 vers la nouvelle feuille
ActiveSheet.Name = t(i1, 1) 'nommer la nouvelle feuille avec le nom idoine
ActiveSheet.Columns("a:o").EntireColumn.AutoFit 'ajuster la largeur des colonnes de la nouvelles feuille
'le nom de société suivant est une nouvelle société, on commencera la copie suivante à la ligne i2+1
i1 = i2 + 1: i2 = i2 + 1
Else
'la société suivante (i2+1)est idendique à la société courante i2, on doit donc
'inclure dans la copie la ligne i2 donc i2 passe à i2+1
i2 = i2 + 1
End If
Loop
End With
End Sub
,
