Discussion :

[Monsieur Peck]

Bonjour,

Je souhaiterai trier les onglets des pages qui sont d'une couleur jaune pâle (couleur 36) par ordre alphabétique en sachant que ces onglets jaunes doivent se trouver après les onglets ayant une autre couleur:

J'ai testé ce code qui fonctionne mais dès que je rajoute la condition de la couleur ça veut plus:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
Sub tri_onglet()
    Dim i As Integer, j As Integer, num As Integer, nom As String
 
    For i = 2 To Sheets.Count
        num = 0: nom = Sheets(i).Name
        For j = i - 1 To 1 Step -1
            If Sheets.Tab.ColorIndex = 36 Then
            If Sheets(i).Name < Sheets(j).Name Then num = j
        Next j
        If num > 0 Then Sheets(i).Move before:=Sheets(num)
    Next i
End If
End Sub

Merci.

[casefayere]

re,
la je les mets tous a la fin, il te suffit de trier apres

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
Sub tri_onglet()
    Dim ongl As Worksheet
    For Each ongl In Worksheets
     If ongl.Tab.ColorIndex = 36 Then
      ongl.Move After:=Sheets(Sheets.Count)
     End If
     Next ongl
 
End Sub

J'ai un code mais attention aux noms d'onglet

si tu les appelles feuil1, feuil2 etc, la feuil10 passera avant la feuil2, logique c'est du texte, sinon voici une proposition, en ayant pris soin de mettre

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

option compare text

en haut du module

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
option compare text
Sub tri_onglet()
Dim i As Integer, x As Integer
Dim ongl As Worksheet
      For Each ongl In Worksheets
         If ongl.Tab.ColorIndex = 36 Then
            ongl.Move after:=Sheets(Sheets.Count)
         End If
      Next ongl
      For i = 1 To Sheets.Count
         If Sheets(i).Tab.ColorIndex = 36 Then Exit For
      Next i
      For x = Sheets.Count To i + 1 Step -1
         If Sheets(x).Name < Sheets(x - 1).Name Then
            Sheets(x - 1).Move after:=Sheets(x)
         End If
      Next x
End Sub

[mercatog]

Une proposition à l'aide de tableaux

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
Sub TriFeuilles()
Dim Tabl() As String, Temp As String
Dim ws As Worksheet
Dim j As Byte, Variab As Byte
Application.ScreenUpdating = False
For Each ws In Worksheets
    If ws.Tab.ColorIndex = 36 Then
        ReDim Preserve Tabl(j + 1)
        Tabl(j) = ws.Name
        j = j + 1
    End If
Next ws
Do              'Tri du tableau
    Variab = 0
    For j = 0 To UBound(Tabl) - 2
        If UCase(Tabl(j + 1)) < UCase(Tabl(j)) Then
            Temp = Tabl(j + 1)
            Tabl(j + 1) = Tabl(j)
            Tabl(j) = Temp
            Variab = 1
        End If
    Next j
Loop While Variab = 1
For j = 0 To UBound(Tabl) - 1
    Sheets(Tabl(j)).Move after:=Sheets(Sheets.Count)
Next j
End Sub

[Monsieur Peck]

Bonjour,

Merci pour vos propositions.