tri onglet alphabetique sauf certains placer à la fin

[charette63]

bonsoir à toutes et tous

dans un classeur excel composé d"une trentaine de feuilles, j'aimerais que le classement des onglets se fasse de façon alphabétique sauf quelques exceptions.

Toutes les feuilles sont nommées par le nom d'un agent, excepté une feuille qui s'appelle "recapitulatif" et (pour l'instant) six qui sont nommées "remplacement 1", "remplacement 2", etc..

Le nombre de feuilles "Remplacement X" est susceptible de changer puisque vouées à être nommées au nom d'un agent.

J'aimerais que les onglets soient triés par ordre alphabétique à l'exception de la feuille "recapitulatif" qui serait toujours en première position, et les feuilles "remplacement X" en dernière position.

j'ai imaginé pour ce faire trois macros, la première pour placer tous les onglets par ordre alphabetique (ça c'est fait)

Sub TriNomsOnglets()
'classement onglets par ordre alphabetique
  On Error Resume Next
  Dim I As Integer, J As Integer
  For I = 1 To Sheets.Count
    For J = I To Sheets.Count
      If UCase(Sheets(J).Name) < UCase(Sheets(I).Name) Then
        Sheets(J).Move Sheets(I)
      End If
    Next J
  Next I
End Sub

la seconde, placer la feuille "recapitulatif" en première position (ça c'est fait également)

Sub Macro6()
'
' Macro6 Macro
' Macro enregistrée le 28/11/2011 par thierry

    Sheets("recapitulatif").Select
    Sheets("recapitulatif").Move Before:=Sheets(1)
End Sub

et enfin, la troisième ( c'est ici que ça se corse (superbe contrée)), qui consisterait à placer les "remplacement X" en fond de liste, et là je rame

il y à un code similaire à celui precedement cité qui permet de placer une feuille en derniere position

Sub Macro7()
'
' Macro7 Macro
' Macro enregistrée le 28/11/2011 par thierry
'
    Sheets("Remplacement 1").Select
    Sheets("Remplacement 1").Move After:=Sheets(34)
End Sub

mais mon problème est qu'il y en aura plusieurs, et un nombre variable.


Pouvez-vous m'aider

merci

cordialement

Thierry

 

[Robert]

Re : tri onglet alphabetique sauf certains placer à la fin

Bonsoir Thierry, bonsoir le forum,

Peut-être comme ça :

Sub TriNomsOnglets()
Dim i As Integer 'déclare la varialbe i (incrément)
Dim x As Integer 'déclare la varialbe x (incrément)
Dim j As Integer 'déclare la varialbe j (incrément)
 
Sheets("recapitulatif").Move Sheets(1) 'place l'onglet "recapitulatif en premier
 
'place tous les onglets "remplacement x" à la fin (sans les trier)
For i = 2 To Sheets.Count 'boucle sur tous les onglets moins le premier
    'condition : si les 12 premiers caractères du nom de l'onglet sont "remplacement"
    If Left(Sheets(i).Name, 12) = "remplacement" Then
        Sheets(i).Move after:=Sheets(Sheets.Count) 'place l'onglet en dernier
        x = x + 1 'incrémente x
    End If 'fin de la condition
Next i 'prochain onglet de la boucle
 
'tri des onglets "remplacement x"
For i = Sheets.Count - x To Sheets.Count
    For j = Sheets.Count - x To Sheets.Count
        If UCase(Sheets(j).Name) < UCase(Sheets(i).Name) Then
            Sheets(j).Move Sheets(i)
        End If
    Next j
Next i
 
'tri des autres onglets
For i = 2 To Sheets.Count - (x - 1)
    For j = Sheets.Count - x To Sheets.Count
        If UCase(Sheets(j).Name) < UCase(Sheets(i).Name) Then
            Sheets(j).Move Sheets(i)
        End If
    Next j
Next i
End Sub

 

[job75]

Re : tri onglet alphabetique sauf certains placer à la fin

Bonjour charette63, salut Robert

Sub TriFeuilles1()
Dim i As Integer, nom1 As String, nom2 As String, t1  As String, t2  As String
Application.ScreenUpdating = False
1 For i = 1 To Sheets.Count - 1
  nom1 = LCase(Sheets(i).Name)
  nom2 = LCase(Sheets(i + 1).Name)
  t1 = "1" & nom1: t2 = "1" & nom2
  If nom1 Like "r?capitulatif*" Then t1 = "0"
  If nom2 Like "r?capitulatif*" Then t2 = "0"
  If nom1 Like "remplacement*" Then t1 = "2" & Format(Val(Mid(nom1, 13)), "000")
  If nom2 Like "remplacement*" Then t2 = "2" & Format(Val(Mid(nom2, 13)), "000")
  If t1 > t2 Then
    Sheets(i).Move After:=Sheets(i + 1)
    GoTo 1
  End If
Next
End Sub

- la feuille recapitulatif - ou récapitulatif - est placée au début

- les feuilles remplacement x (maximum 999) sont classées et placées à la fin

- les autres feuilles sont classées et placées au milieu.

A+

 

[C@thy]

Re : tri onglet alphabetique sauf certains placer à la fin

Bravo Gérard (job75) pour ta soluce qui fonctionne parfaitement.

Toutefois j'ai poussé le bouchon un peu loin pour voir...
j'ai bien remplacement1, remplacement 2, remplacement10, (tu as bien géré le coup!)
mais j'ai Feuil1, feuil10, feuil2...

Cela dit, ce cas ne se produira pas dans l'exemple donné car il n'y aura pas de DUPONT1 DUPONT2... DUPONT10,
alors no souci!

Au passage, j'en profite pour vous livrer une macro tri faite par notre ami Ti (un seul index...de la belle ouvrage!)
le tout à mettre dans Thisworkbook (comme ça le tri se fait automatiquement dès qu'on déplace les feuilles ou qu'on change le nom... astucieux!):
Option Explicit
'Ti - Ce lien n'existe plus
Private Sub TriFeuilles()
Dim Index%, Sh As Object
'évidemment, les feuilles ne doivent pas être protégées !
On Error Resume Next
With ThisWorkbook
For Each Sh In ThisWorkbook.Sheets
For Index = 1 To .Sheets.Count
If LCase(Sh.Name) > LCase(.Sheets(Index).Name) And Sh.Index < Index Then
Sh.Move , .Sheets(Index)
End If
Next Index
Next Sh
End With
End Sub

Private Sub Workbook_NewSheet(ByVal Sh As Object)
TriFeuilles
End Sub

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
TriFeuilles
End Sub

Bises

C@thy

 

[job75]

Re : tri onglet alphabetique sauf certains placer à la fin

Coucou C@thy

En effet s'il y a des noms de feuilles qui se terminent par un nombre, (maximum 999 encore) on peut les classer suivant ce nombre grâce à la fonction class ci dessous :

Sub TriFeuilles2()
Dim i%, nom1$, nom2$, t1$, t2$
Application.ScreenUpdating = False
1 For i = 1 To Sheets.Count - 1
  nom1 = LCase(Sheets(i).Name)
  nom2 = LCase(Sheets(i + 1).Name)
  t1 = "1" & class(nom1): t2 = "1" & class(nom2)
  If nom1 Like "r?capitulatif*" Then t1 = "0"
  If nom2 Like "r?capitulatif*" Then t2 = "0"
  If nom1 Like "remplacement*" Then t1 = "2" & Format(Val(Mid(nom1, 13)), "000")
  If nom2 Like "remplacement*" Then t2 = "2" & Format(Val(Mid(nom2, 13)), "000")
  If t1 > t2 Then
    Sheets(i).Move After:=Sheets(i + 1)
    GoTo 1
  End If
Next
End Sub

Function class$(nom$)
Dim i%
nom = Trim(nom)
For i = Len(nom) To 1 Step -1
  If Not IsNumeric(Mid(nom, i, 1)) Then Exit For
Next
If i Then
  class = Left(nom, i) & Format(Val(Mid(nom, i + 1)), "000")
Else
  class = Format(Val(nom), "000")
End If
End Function

A+

 

[C@thy]

Re : tri onglet alphabetique sauf certains placer à la fin

C'est la classe, job!!!

Dans ce cas il ne faut pas avoir de Feuil01 Feuil02 etc.. car Feuil1 passerait avant Feuil02..
Surtout ne modifie rien, c'est parfait, on n'a jamais feuil01 et feuil1 à la fois, c'est incohérent!!!

Bises

C@thy

 

[charette63]

bonjour,

merci à vous trois de vous être penché sur mon problème (d'après certain, il n'y a pas de problème, il n'y a que des solutions)

Robert, la partie du code qui consiste à placer les "remplacement" en derniere position me posait problème, j'avais trois "remplacement" sur six qui se placeaient en fin de liste. En décortiquant ta macro, j'ai isolé cette partie et j'ai du lancer ce morceau de code à trois reprises pour que les six "remplacement" daignent se positionner en fin de liste.

Job75, le premier code que tu m'as renseigné, à l'exception de "recapitulatif", me plaçait les (remplacement) alphabétiquement, mais pas en fin de liste. Par contre le second, avec la fonction me donne entière satisfaction.

Avec tout mes remerciements

cordialement

Thierry

 

[job75]

Re : Re: tri onglet alphabetique sauf certains placer à la fin

Re,

Job75, le premier code que tu m'as renseigné, à l'exception de "recapitulatif", me plaçait les (remplacement) alphabétiquement, mais pas en fin de liste. Par contre le second, avec la fonction me donne entière satisfaction.

Pas logique et ça ne colle pas avec mes tests...

Ma 1ère macro avec le "2" place les feuilles remplacement x forcément à la fin.

Et la fonction class pour la 2ème ne classe pas à la fin....

Il faudrait voir votre fichier.

A+

 

[charette63]

Re: Re : tri onglet alphabetique sauf certains placer à la fin

salut Job

je comprend ton scepticisme, mais test et retest, même résultat.
Une petite précision qui a peut-être son importance, les "autres" feuilles sont nommées par un nom, espace, et initiale du prénom.

exemple Durant M

en serait-ce la cause?

 

[job75]

Re : tri onglet alphabetique sauf certains placer à la fin

Re,

Le nom et le prénom peuvent être écrits comme vous voulez, avec le "1" ils seront forcément au milieu.

Et je répète remplacement x avec le "2" forcément à la fin.

Vraiment je suis curieux de voir le fichier

A+

 

[job75]

Re : tri onglet alphabetique sauf certains placer à la fin

Re,

Bon, le problème est résolu après un échange de MP.

Comme ses feuilles se nommaient Remplacement x (avec une majuscule) charette63 a cru bien faire en écrivant :

If nom1 Like "Remplacement*" Then t1 = "2" & Format(Val(Mid(nom1, 13)), "000")
If nom2 Like "Remplacement*" Then t2 = "2" & Format(Val(Mid(nom2, 13)), "000")

alors qu'il faut impérativement laisser :

If nom1 Like "remplacement*" Then t1 = "2" & Format(Val(Mid(nom1, 13)), "000")
If nom2 Like "remplacement*" Then t2 = "2" & Format(Val(Mid(nom2, 13)), "000")

puisque la fonction LCase met les noms en minuscule :

nom1 = LCase(Sheets(i).Name)
nom2 = LCase(Sheets(i + 1).Name)

C'est indispensable pour le tri.

Avant de modifier une macro il faut comprendre comment elle fonctionne.

A+

 

[charette63]

eh bien, cher job75, merci beaucoup

effectivement, c'était marqué "touche pas à ça p'tit c..", mais je l'avais pas vu et comme tu l'ecris si bien en début de message, j'ai cru bien faire.

tout mes remerciements

 

[job75]

Re : tri onglet alphabetique sauf certains placer à la fin

Re,

Les macros c'est comme le lapin du métro :

Ne mets pas tes mains sur la porte, tu risques de te faire pincer très fort

A bientôt Thierry