Macro tier les onglet sauf une

[vserrano]

Bonjour à tous,

Je souhaiterai trier mes onglets sauf une qui va s'appeler "NOUVEAU MODELE"

Le petit hic c'est que les onglets seront rénommés dans cet exemple
140118 LYON
140718 LYON
180818 LYON
030118 PARIS
020118 NICE
ETC

Merci de votre aide

 

[vgendron]

Sans passer par le quicksort (avec lequel je ne m'en sors pas...)
il faut juste une feuille 1 pour y coller la liste des onglets et faire le tri

Sub TriFeuilles()
Application.EnableEvents = False
Dim tabFeuille() As Variant 'déclare un tableau
nb = Sheets.Count - 2
ReDim tabFeuille(1 To nb, 2) 'dimensionne le tableau de "nombres de feuilles -1" lignes et 2 colonnes

i = 1
For Each ws In Sheets 'pour chaque feuille du classeurs
    If ws.Name <> "NOUVEAU MODELE" And ws.Name <> "Feuil1" Then
        tabFeuille(i, 1) = DateSerial(Right(Split(ws.Name, " ")(0), 2), Mid(Split(ws.Name, " ")(0), 3, 2), Left(Split(ws.Name, " ")(0), 2)) 'première colonne prend la date
'        MsgBox Left(Split(ws.Name, " ")(0), 2)
'        MsgBox Mid(Split(ws.Name, " ")(0), 3, 2)
'        MsgBox Right(Split(ws.Name, " ")(0), 2)
'        MsgBox DateSerial(Right(Split(ws.Name, " ")(0), 2), Mid(Split(ws.Name, " ")(0), 3, 2), Left(Split(ws.Name, " ")(0), 2))
         tabFeuille(i, 2) = Split(ws.Name, " ")(1) 'seconde colonne prend la ville
        i = i + 1
    End If
Next ws
Sheets("Feuil1").Range("A1").Resize(UBound(tabFeuille, 1), 3) = tabFeuille

With Sheets("Feuil1")
   
    .Sort.SortFields.Clear
    .Sort.SortFields.Add Key:=Range("B1:B" & nb), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    .Sort.SortFields.Add Key:=Range("C1:C" & nb), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
   
    With ActiveWorkbook.Worksheets("Feuil1").Sort
        .SetRange Range("B1:C" & nb)
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    tabFeuille = .Range("B1:C" & nb).Value
End With


LastFeuille = "NOUVEAU MODELE"
For i = LBound(tabFeuille, 1) To UBound(tabFeuille, 1) 'on parcourt le tableau
    Sheets("" & Format(tabFeuille(i, 1), "ddmmyy") & " " & tabFeuille(i, 2) & "").Move after:=Sheets(LastFeuille) 'et on déplace la feuille
    LastFeuille = Format(tabFeuille(i, 1), "ddmmyy") & " " & tabFeuille(i, 2)
Next i
Application.EnableEvents = True
End Sub

 

[vserrano]

Vraiment désolée mais je n'y arrive pas !!!

Voici mon fichier casi fini sauf pour le tri,par contre je ne veux pas qu'il trie "NOUVEAU MODELE" et "RECAPITULATIF"

Merci infiniment.

Valerie

 

[zebanx]

Bonjour Vgendron et vserrano.

Bravo Vgendron pour ce code et l'utilisation de la serial date dans un tableau, vraiment bien😉.
(Remarque : qqs modifications sur les tris pour passer avec excel 2003 et ajout/suppression feuille tampon "Feuil1" mais ça parait bien fonctionner - j'en suis resté à une colonne NOUVEAU MODELE et ensuite ALPHA + noms de villes pour les autres feuilles).

Le seul truc que je trouve bizarre, c'est sur la "Feuil1" que l'instruction "Sheets("Feuil1").Range("A1").Resize(UBound(tabFeuille, 1), 3) = tabFeuille"
amène sur les colonnes 2 et 3 (2 pour la date et 3 pour la ville) et non sur les colonnes 1 et 2.

Mais bravo à toi, code à conserver.
Ou par défaut penser à transformer la notation de "jjmmaa" à "aaaammjj" et utiliser une macro de tri classique d'onglet. Un peu de méthode mais là au moins...

++
zebanx

 

[vgendron]

suffit de rajouter le code dans un module
d'ajouter une feuille "feuil1"
et de modifier un indice..

 

[vgendron]

"Sheets("Feuil1").Range("A1").Resize(UBound(tabFeuille, 1), 3) = tabFeuille"
amène sur les colonnes 2 et 3 (2 pour la date et 3 pour la ville) et non sur les colonnes 1 et 2.

hehe. c'est un truc que je ne pige pas toujours non plus..
mon tabfeuille fait 2 colonnes (Date et Ville)
mais il faut lui dire de les mettre sur 3..
tout est dans le lbound et ubound et indice 0
mais la. honnetement. j'avais pas envie de creuser... 🙂

 

[vserrano]

Vous êtes trop génial merci beaucoup !!!!