Macro tier les onglet sauf une

V

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
 
Trier par date Trier par votes
V

vserrano

XLDnaute Junior
Re et merci

voici le fichier, j'ai bien une macro mais elle me trie les onglets mais dans la logique le 120818 LYON devrait etre entre le 140718 et le 180818

Merci beaucoup
 

Pièces jointes

  • Suivi gmt pour excel Downloads.xlsm
    63.2 KB · Affichages: 21
Vote positif 0 Vote négatif
vgendron

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
 
Vote positif 0 Vote négatif
vgendron

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
 
Vote positif 0 Vote négatif
V

vserrano

XLDnaute Junior
vgendron à dit:
qu'est ce qui est rouge??
chez moi, pas de pb..
voir PJ
Cliquez pour agrandir...


en faite je veux tous les janvier ensemble fevrier etc, du coup le 030118 PARIS est apres le 020318 lyon

upload_2018-1-8_14-45-48.png
 
Vote positif 0 Vote négatif
V

vserrano

XLDnaute Junior
vgendron à dit:
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
Cliquez pour agrandir...
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
 
Vote positif 0 Vote négatif
vgendron

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
 
Vote positif 0 Vote négatif
V

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
 
Vote positif 0 Vote négatif
V

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
 
Vote positif 0 Vote négatif

Discussions similaires

M
  • Résolu(e)
Microsoft 365 Gestion numéros de pages du classeur dans une cellule
2
Réponses
16
Affichages
492
sousou
sousou
A
  • Résolu(e)
Microsoft 365 Formule indirect?
Réponses
4
Affichages
280
AlexiaC
A
T
  • Question
XL 2019 Macros désactivées mais la macro WorkBook_Open est exécutée
Réponses
2
Affichages
279
ThierryP
T
A
  • Résolu(e)
Microsoft 365 Macro pour split de données sur onglet nommé
2
Réponses
18
Affichages
1 K
Arnaud Legay
A
B
  • Question
XL 2013 Automatiser une formule sur les nouvelles lignes insérées en fonction d'une recherche sur les enregistrements
Réponses
9
Affichages
204
bedley
B
J
  • Résolu(e)
Microsoft 365 macro effacement sélection cellules
2 3 4
Réponses
55
Affichages
2 K
Phil69970
Phil69970
Roseline
  • Résolu(e)
Microsoft 365 Colorier une cellule en fonction de critère d'un autre onglet
Réponses
6
Affichages
486
patricktoulon
patricktoulon
L
  • Question
XL 2016 Recherche de partie de mot dans les cellules d'un tableau et extractions des résultats
2
Réponses
29
Affichages
1 K
Lorenzini
L
C
  • Question
XL 2019 Tableau- creation de lignes: probleme de hauteur de lignes
Réponses
6
Affichages
372
Cheyenne_2021
C
P
  • Question
XL 2013 Copier une formule dans un cellule depuis une cellule d'un onglet nouvellement crée en macro VBA
Réponses
8
Affichages
468
pascalou1
P

Membres actuellement en ligne

3 membres et 40 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
312 023
Messages
2 084 715
Membres
102 637
dernier inscrit
TOTO33000