Sub toto()
Dim feuille
With ActiveWorkbook
For Each feuille In .Sheets
If feuille.Tab.ColorIndex = 55 Then feuille.Move After:=Sheets(Sheets.Count)
Next
End With
End Sub
toto
Je n'avais pas vu ce message quand j'ai répondu ci-dessus.En fait j’ai une autre condition ma collègue veut que ce soit également par ordre alphabétique dont les bleus en 1er par ordre alphabétique et les violets à la fin également par ordre alphabétique.
Bon ! Alors essayez cela :il n'y aura pas d'autres questions c'est bon en fait, il faudrait que ce soit en 1er la couleur bleu, en 2ème la violette mais que les 2 soient par ordre alphabétique
Sub tata()
Dim c%, i&, tmp$, feuille
Application.ScreenUpdating = False
couleurs = Array(37, 55)
With ActiveWorkbook
For c = 0 To UBound(couleurs)
ReDim noms(0)
For Each feuille In .Sheets
If feuille.Tab.ColorIndex = couleurs(c) Then ReDim Preserve noms(1 + UBound(noms)): noms(UBound(noms)) = feuille.Name
Next
For i = 1 To UBound(noms) - 1
tmp = noms(i)
For j = i + 1 To UBound(noms)
If tmp > noms(j) Then noms(i) = noms(j): noms(j) = tmp: tmp = noms(i)
Next
.Sheets(tmp).Move After:=.Sheets(Sheets.Count)
Next
.Sheets(noms(UBound(noms))).Move After:=.Sheets(Sheets.Count)
Next
End With
Application.ScreenUpdating = True
End Sub
Au poil !Merci beaucoup c'est super !!
bonne journée