Macro tier les onglet sauf une

vserrano

XLDnaute Junior
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

XLDnaute Barbatruc
Bonjour

il nous faudrait plus de détails.. et un fichier exemple
tu les classes selon le numéro ou d'abord par Ville PUIS numéro?

l'idée est:
1) Lister les onglets
2) trier
3) déplacer les onglets selon la liste triée
 

vgendron

XLDnaute Barbatruc
Hello

avec ceci à tester
tri sur la Ville PUIS la date
VB:
Sub TriFeuilles()
Application.EnableEvents = False
Dim tabFeuille() As Variant
nb = Sheets.Count - 1
ReDim tabFeuille(1 To nb, 2)

i = 1
For Each ws In Sheets
    If ws.Name <> "NOUVEAU MODELE" Then
        tabFeuille(i, 1) = Split(ws.Name, " ")(0)
         tabFeuille(i, 2) = Split(ws.Name, " ")(1)
        i = i + 1
    End If
Next ws
Tri tabFeuille(), LBound(tabFeuille, 1), UBound(tabFeuille, 1), 2, 1
LastFeuille = "NOUVEAU MODELE"
For i = LBound(tabFeuille, 1) To UBound(tabFeuille, 1)
    Sheets("" & tabFeuille(i, 1) & " " & tabFeuille(i, 2) & "").Move after:=Sheets(LastFeuille)
    LastFeuille = tabFeuille(i, 1) & " " & tabFeuille(i, 2)
Next i
Application.EnableEvents = True
End Sub


Sub Tri(a(), gauc, droi, Col1erTri, Col2ndTri) ' Quick sort
  ref = a((gauc + droi) \ 2, Col1erTri) & a((gauc + droi) \ 2, Col2ndTri)
  g = gauc: d = droi
  Do
    Do While a(g, Col1erTri) & a(g, Col2ndTri) < ref: g = g + 1: Loop
    Do While ref < a(d, Col1erTri) & a(d, Col2ndTri): d = d - 1: Loop
      If g <= d Then
        For k = LBound(a, Col1erTri) To UBound(a, Col1erTri)
           temp = a(g, k): a(g, k) = a(d, k): a(d, k) = temp
        Next k
        g = g + 1: d = d - 1
      End If
   Loop While g <= d
   If g < droi Then Call Tri(a, g, droi, Col1erTri, Col2ndTri)
  If gauc < d Then Call Tri(a, gauc, d, Col1erTri, Col2ndTri)
End Sub
 

vserrano

XLDnaute Junior
Je viens de le tester sur un nouveau classeur( avec la ville + date) effectivement ca marche bien, mais il nous faut vraiment d'abord les dates.

Merci encore ;-)
 

vgendron

XLDnaute Barbatruc
mais il nous faut vraiment d'abord les dates.

d'ou ma question à laquelle tu n'as pas répondu.. VILLE et date ou Date puis ville...

il faut modifier deux lignes
VB:
Sub TriFeuilles()
Application.EnableEvents = False
Dim tabFeuille() As Variant 'déclare un tableau
nb = Sheets.Count - 1
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" Then
        tabFeuille(i, 1) = Split(ws.Name, " ")(0) 'première colonne prend la date
         tabFeuille(i, 2) = Split(ws.Name, " ")(1) 'seconde colonne prend la ville
        i = i + 1
    End If
Next ws
Tri tabFeuille(), LBound(tabFeuille, 1), UBound(tabFeuille, 1), 1, 2 'on lance le tri quicksort

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


Sub Tri(a(), gauc, droi, Col1erTri, Col2ndTri) ' Quick sort
  ref = a((gauc + droi) \ 2, Col1erTri) & a((gauc + droi) \ 2, Col2ndTri)
  g = gauc: d = droi
  Do
    Do While a(g, Col1erTri) & a(g, Col2ndTri) < ref: g = g + 1: Loop
    Do While ref < a(d, Col1erTri) & a(d, Col2ndTri): d = d - 1: Loop
      If g <= d Then
        For k = LBound(a, Col2ndTri) To UBound(a, Col2ndTri)
           temp = a(g, k): a(g, k) = a(d, k): a(d, k) = temp
        Next k
        g = g + 1: d = d - 1
      End If
   Loop While g <= d
   If g < droi Then Call Tri(a, g, droi, Col1erTri, Col2ndTri)
  If gauc < d Then Call Tri(a, gauc, d, Col1erTri, Col2ndTri)
End Sub
 

vserrano

XLDnaute Junior
mais il nous faut vraiment d'abord les dates.

d'ou ma question à laquelle tu n'as pas répondu.. VILLE et date ou Date puis ville...

il faut modifier deux lignes
VB:
Sub TriFeuilles()
Application.EnableEvents = False
Dim tabFeuille() As Variant 'déclare un tableau
nb = Sheets.Count - 1
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" Then
        tabFeuille(i, 1) = Split(ws.Name, " ")(0) 'première colonne prend la date
         tabFeuille(i, 2) = Split(ws.Name, " ")(1) 'seconde colonne prend la ville
        i = i + 1
    End If
Next ws
Tri tabFeuille(), LBound(tabFeuille, 1), UBound(tabFeuille, 1), 1, 2 'on lance le tri quicksort

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


Sub Tri(a(), gauc, droi, Col1erTri, Col2ndTri) ' Quick sort
  ref = a((gauc + droi) \ 2, Col1erTri) & a((gauc + droi) \ 2, Col2ndTri)
  g = gauc: d = droi
  Do
    Do While a(g, Col1erTri) & a(g, Col2ndTri) < ref: g = g + 1: Loop
    Do While ref < a(d, Col1erTri) & a(d, Col2ndTri): d = d - 1: Loop
      If g <= d Then
        For k = LBound(a, Col2ndTri) To UBound(a, Col2ndTri)
           temp = a(g, k): a(g, k) = a(d, k): a(d, k) = temp
        Next k
        g = g + 1: d = d - 1
      End If
   Loop While g <= d
   If g < droi Then Call Tri(a, g, droi, Col1erTri, Col2ndTri)
  If gauc < d Then Call Tri(a, gauc, d, Col1erTri, Col2ndTri)
End Sub
Alors effectivement j'avais pas lu la question, j'ai une macro qui renome l'onglet par rapport a la cellule A1 qui doit etre dans ce sens date+ville et du coup trier tous les janviers ensemble et ainsi de suite

Merci bien
 

vgendron

XLDnaute Barbatruc
un peu de lecture ici :)
http://boisgontierjacques.free.fr/

Section Tableaux puis tri

et il faut indiquer à VBA que 030118.. c'est une date.... donc. il y a un peu de transformation à faire

VB:
For Each ws In Sheets 'pour chaque feuille du classeurs
    If ws.Name <> "NOUVEAU MODELE" 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
        tabFeuille(i, 2) = Split(ws.Name, " ")(1) 'seconde colonne prend la ville
        i = i + 1
    End If
Next ws
 

vserrano

XLDnaute Junior
Bonjour vgendron,

je vous remercie pour votre aide du coup je prends ce code que je cole au module ou il faut que je le rejoute ?

Excusez mon apprentissage !!

For Each ws In Sheets 'pour chaque feuille du classeurs
If ws.Name <> "NOUVEAU MODELE" 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
tabFeuille(i, 2) = Split(ws.Name, " ")(1) 'seconde colonne prend la ville
i = i + 1
End If
Next ws
 

vserrano

XLDnaute Junior
Du coup je l'ai remplacé par l'ancienne (pour chaque feuille) et ca dit qu'il y a un beug sur la ligne jaune.



Sub TriFeuilles()
Application.EnableEvents = False
Dim tabFeuille() As Variant 'déclare un tableau
nb = Sheets.Count - 1
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" 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
tabFeuille(i, 2) = Split(ws.Name, " ")(1) 'seconde colonne prend la ville
i = i + 1
End If
Next ws

Tri tabFeuille(), LBound(tabFeuille, 1), UBound(tabFeuille, 1), 1, 2 'on lance le tri quicksort

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


Sub Tri(a(), gauc, droi, Col1erTri, Col2ndTri) ' Quick sort
ref = a((gauc + droi) \ 2, Col1erTri) & a((gauc + droi) \ 2, Col2ndTri)
g = gauc: d = droi
Do
Do While a(g, Col1erTri) & a(g, Col2ndTri) < ref: g = g + 1: Loop
Do While ref < a(d, Col1erTri) & a(d, Col2ndTri): d = d - 1: Loop
If g <= d Then
For k = LBound(a, Col2ndTri) To UBound(a, Col2ndTri)
temp = a(g, k): a(g, k) = a(d, k): a(d, k) = temp
Next k
g = g + 1: d = d - 1
End If
Loop While g <= d
If g < droi Then Call Tri(a, g, droi, Col1erTri, Col2ndTri)
If gauc < d Then Call Tri(a, gauc, d, Col1erTri, Col2ndTri)
End Sub
 

vgendron

XLDnaute Barbatruc
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

VB:
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
 

zebanx

XLDnaute Accro
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

XLDnaute Barbatruc
"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... :)
 

Créez un compte ou connectez vous pour répondre

Vous devez être membre afin de pouvoir répondre ici

Créer un compte

Créez un compte Excel Downloads. C'est simple!

Connexion

Vous avez déjà un compte? Connectez vous ici.

Haut Bas