Tri en masse Excel 2007 Résolu

Question

Bonjour, 

Je n'arrive pas à mettre en place sur excel un tri. Mon niveau et très bas aussi.

Je fais une extraction de ma base de donnée AS400 vers excel sur la feuille 1, cela représente 50 000 références.
Chaque référence a :
Code Fourisseur / Ref / Description / Prix / Famille / Ss famille.

J'aimerai pouvoir créer un tri qui me permettrait de mettre dans différentes feuille les références ayant les memes famille / ss famille

Pouvez vous m'aider svp ?

Merci



Configuration: Windows 7 / Firefox 8.0

pijaku · Answer

Bonjour,
Combien as tu de familles? Sous familles?
Tu fais une extraction régulièrement ou c'est juste pour une fois?

Dauphins · Answer

Merci de ta réponse 

J'ai environ 40 familles et 100 sous familles au total.

C'est une extraction que je fais régulièrement pour différent traitement donc c'est pour cela que je voudrai automatiser au mieux la chose pour gagner du temps

Merci encore

Dauphins · Answer

En faite je veux une feuille par famille sous famille

Ex Famille 1 Sous Famille 1
Ex Famille 1 Sous Famille 2
Ex Famille 1 Sous Famille 3
Ex Famille 2 Sous Famille 1
Ex Famille 2 Sous Famille 2
Ex Famille 2 Sous Famille 1
Ex Famille 2 Sous Famille 3

Donc la feuille 1 c'est Famille 1 Sous Famille 1
la feuille 2 c'est Famille 1 Sous Famille 2
la feuille 3 c'est Famille 1 Sous Famille 3
etc...

Et en gardant les entete de colonnes comme tu as dis

Dauphins · Answer

Sincerement un grand merci de ton aide

Dauphins · Answer

Effectivement cela fais beaucoup de feuilles excel mais toutes les formes de famille/ ss famille ne sont pas utilisé. En gros il faut compter max 200 feuilles excel.

Dauphins · Answer

Oui une sécurité c'est mieux

Merci

Dauphins · Answer

ok

Dauphins · Answer

Oui il n'y a aucune cellule vide dans chaque colonne

pijaku · Answer

Bon 16:56, ma solution. 
Testée sur 35 000 lignes et l'ajout de 100 feuilles, durée 12,54 secondes... 
Pour plus de lignes et plus de feuilles, prévoir plus de temps! 
J'ai enlevé l'option de vérification de l'existence des feuilles. Si tu ne le fais qu'une fois par fichier, elle est inutile. 

Précaution d'usage :  
Travailler sur une copie de votre fichier..... Ne venez pas pleurer si vos données sont irrémédiablement perdues... 

Voici le code de la macro à insérer dans un module standard : 
Option Explicit 
Option Base 1 

Sub Repartition() 
Dim DicoConcat As Object 
Dim concat(), Colonns(), TablDico() 
Dim DrLig As Long, i As Long, j As Long, Lig As Long, Col As Long 

Application.ScreenUpdating = False 
With Sheets("Feuil1") 
    DrLig = .Range("A" & Rows.Count).End(xlUp).Row 
    ReDim concat(DrLig) 
    ReDim Colonns(1 To DrLig, 1 To 6) 
    For i = 2 To DrLig 
        For j = 1 To 6 
            Colonns(i - 1, j) = .Cells(i, j) 
        Next j 
        concat(i - 1) = Colonns(i - 1, 5) & "_" & Colonns(i - 1, 6) 
    Next i 
End With 
Set DicoConcat = CreateObject("Scripting.Dictionary") 
For i = LBound(concat) To UBound(concat) 
    DicoConcat(concat(i)) = "" 
Next i 
If DicoConcat.Count + ThisWorkbook.Worksheets.Count >= 250 Then 
    MsgBox "Votre classeur va dépasser les 250 feuilles. Fractionnez le au préalable." 
    Exit Sub 
End If 
TablDico = DicoConcat.keys 
'Si vous souhaitez tester si la feuille a déjà été créée 
'enlevez les apostrophes en début des lignes suivantes 
For i = 1 To UBound(TablDico) - 1 
'    If FeuilleExiste(TablDico(i)) = False Then 
        ThisWorkbook.Worksheets.Add 
        With ActiveSheet 
            .Name = TablDico(i) 
            .Range("A1") = "Fournisseur" 
            .Range("B1") = "Ref" 
            .Range("C1") = "Description" 
            .Range("D1") = "Prix" 
            .Range("E1") = "Famille" 
            .Range("F1") = "Sous famille" 
            For j = 1 To UBound(concat) 
                If concat(j) = TablDico(i) Then 
                    Lig = .Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Row 
                    For Col = 1 To 6 
                        .Cells(Lig, Col) = Colonns(j, Col) 
                    Next 
                End If 
            Next j 
        End With 
'    Else 
'        With Sheets(concat) 
'            .Cells.Clear 
'        End With 
'    End If 
Next i 
Sheets("Feuil1").Select 

End Sub 

Function FeuilleExiste(NomFeuille) As Boolean 
    Dim f As Object 
    On Error Resume Next 
    Set f = Sheets(NomFeuille) 
    If Err = 0 Then FeuilleExiste = True 
    Set f = Nothing 
End Function

J'oubliais... Vérifiez bien que toutes vos donénes sont encore présentes après traitement...
Possibilité également d'effacement de la feuille Feuil1, mais vérifiez vos données au préalable...
Cordialement, 
Franck P

Dauphins · Answer

Je test cela rapidement et je te dis. Un grand merci de ta réponse et ton efficacité. Bon weekend à toi

pijaku · Answer

Bon ceci semble mieux fonctionner.....
Il faut remplacer la ligne :
For i = 1 To UBound(TablDico) - 1
par :
For i = 0 To UBound(TablDico) - 1
soit :
Option Explicit
Option Base 1

Sub Repartition()
Dim DicoConcat As Object
Dim concat(), Colonns(), TablDico()
Dim DrLig As Long, i As Long, j As Long, Lig As Long, Col As Long

Application.ScreenUpdating = False
With Sheets("Feuil1")
    DrLig = .Range("A" & Rows.Count).End(xlUp).Row
    ReDim concat(DrLig)
    ReDim Colonns(1 To DrLig, 1 To 6)
    For i = 2 To DrLig
        For j = 1 To 6
            Colonns(i - 1, j) = .Cells(i, j)
        Next j
        concat(i - 1) = Colonns(i - 1, 5) & "_" & Colonns(i - 1, 6)
    Next i
End With
Set DicoConcat = CreateObject("Scripting.Dictionary")
For i = LBound(concat) To UBound(concat)
    DicoConcat(concat(i)) = ""
Next i
If DicoConcat.Count + ThisWorkbook.Worksheets.Count >= 250 Then
    MsgBox "Votre classeur va dépasser les 250 feuilles. Fractionnez le au préalable."
    Exit Sub
End If
TablDico = DicoConcat.keys
'Si vous souhaitez tester si la feuille a déjà été créée
'enlevez les apostrophes en début des lignes suivantes
For i = 0 To UBound(TablDico) - 1
'    If FeuilleExiste(TablDico(i)) = False Then
        ThisWorkbook.Worksheets.Add
        With ActiveSheet
            .Name = TablDico(i)
            .Range("A1") = "Fournisseur"
            .Range("B1") = "Ref"
            .Range("C1") = "Description"
            .Range("D1") = "Prix"
            .Range("E1") = "Famille"
            .Range("F1") = "Sous famille"
            For j = 1 To UBound(concat)
                If concat(j) = TablDico(i) Then
                    Lig = .Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Row
                    For Col = 1 To 6
                        .Cells(Lig, Col) = Colonns(j, Col)
                    Next
                End If
            Next j
        End With
'    Else
'        With Sheets(concat)
'            .Cells.Clear
'        End With
'    End If
Next i
Sheets("Feuil1").Select

End Sub

Function FeuilleExiste(NomFeuille) As Boolean
    Dim f As Object
    On Error Resume Next
    Set f = Sheets(NomFeuille)
    If Err = 0 Then FeuilleExiste = True
    Set f = Nothing
End Function

Dauphins · Answer

Merci, mais de mon coté cela ne fonctionne pas, il me crée quelques feuilles et c'est tout mais tu as fais un très bon boulot quand meme

Dauphins · Answer

Je viens de viens de faire un test. Quand je supprime les informations dans la colonne C "Description" cela fonctionne très bien. Je ne comprends pas pourquoi ca ne passe pas avec la description.
De plus je vais surement être trop gourmand, mais est il possible que le nom des feuilles soit un nom donné. Par ex la famille 1 sous famille 1 Banane, la famille 1 sous famille 2 Pomme ?

Dauphins · Answer

je viens de comprendre, dans la colonne C il y a des symboles = / + .... si je les enlève et laisse le texte tout se passe bien. Maintenant ou modifier dans le code pour que les symboles ne m'embêtent plus ?

Dauphins · Answer

Bonjour,

Oui un petit weekend travail et toi ?

Je pensais pour le changement de nom créer une feuille avec :
2_1 = Pomme
2_2 = Banane....

De là lancer une macro qui va lire et remplacer.

Pour les symboles ce sont : ><-+=

Encore merci de ton aide

Dauphins · Answer

Non aucune formule, les symboles ont été mit dans la description simplement pour la compréhension ex : 
CUVE >12345678
BILLE $
FIL HUILE >a5879/2 >

Les familles et sous familles ne changerons jamais, au pire ce qu'il peut arriver c'est qu'il faille en rajouter 

ex : 01_07 : Famille : Moteur Ss famille : Volant moteur et j'aimerai afficher a la place de 01_07 : Volant moteur

Dauphins · Answer

Ok pour ton code famille sous famille donc si je comprends bien en feuille deux je mets la désignation en face mais cela va t il modifier le nom de la feuille ou pas ?

Pour les symboles le mieux c'est qu'ils restent en place, mais si pour se faciliter la tache on les enleves ce n'est pas grave

Dauphins · Answer

Ok mais est il possible de mettre cela en dur une liste ? Car en faite ces macro seront utilisé par plusieurs personnes et je les voient pas rentrer a chaque fois les nom des familles sous famille

Pour moi quand je lance la macro elle se lance mais au bout de quelques secondes cela plante, si j'enleve tous les symboles cela fonctionne

Dauphins · Answer

Ok pour les symboles.

Si tu peux tout jumelé ensemble pourquoi pas, si cela est possible

Dauphins · Answer

sincerement ce n'est pas grave si je perds 2mn car actuellement on fait cela a la mains j'en ai pour 1 bonnes journée, merci

pijaku · Answer

Alors voici l'ensemble des codes regroupés en deux macros et une fonction...
Durée d'exécution chez moi (pour te donner un ordre d'idée) pour 35 000 lignes : 29 secondes 25 centièmes...

Option Explicit
Option Base 1

Sub Repartition()
Dim DicoConcat As Object
Dim concat(), Colonns(), TablDico(), Symb()
Dim DrLig As Long, i As Long, j As Long, Lig As Long, Col As Long
Dim Wsh As Worksheet
Dim Trouve As Range
Dim Message As String
Dim test As Boolean

Application.ScreenUpdating = False
'-----------------------------------------------'
'------ Effacement des symboles colonne C ------'
'-----------------------------------------------'
Symb = Array(">", "<", "-", "+", "=", "$") 'tu peux ajouter ici autant de symboles que nécessaire!!!
With Sheets("Feuil1")
    DrLig = .Range("C" & Rows.Count).End(xlUp).Row
    For Lig = 1 To DrLig
        For i = LBound(Symb) To UBound(Symb)
            If InStr(.Cells(Lig, 3), Symb(i)) <> 0 Then
                .Cells(Lig, 3) = Replace(.Cells(Lig, 3), Symb(i), "")
            End If
        Next i
    Next Lig
'------------------------------------------------------------'
'-- remplissage des variables avec le contenu de la Feuil1 --'
'------------------------------------------------------------'
    DrLig = .Range("A" & Rows.Count).End(xlUp).Row
    ReDim concat(DrLig)
    ReDim Colonns(1 To DrLig, 1 To 6)
    For i = 2 To DrLig
        For j = 1 To 6
            'Colonns = toutes les données deFeuil1
            Colonns(i - 1, j) = .Cells(i, j)
        Next j
        'concat = concaténation des colonnes E & F
        concat(i - 1) = Colonns(i - 1, 5) & "_" & Colonns(i - 1, 6)
    Next i
End With
'-------------------------------------------------------------'
'-- Etablit la liste sans doublons des Familles_ss familles --'
'-------------------------------------------------------------'
Set DicoConcat = CreateObject("Scripting.Dictionary")
For i = LBound(concat) To UBound(concat)
    DicoConcat(concat(i)) = ""
Next i
'-------------------------------------------------------------'
'- Compte si le futur nombre de feuilles est supérieur à 250 -'
'-------------------------------------------------------------'
If DicoConcat.Count + ThisWorkbook.Worksheets.Count >= 250 Then
    MsgBox "Votre classeur va dépasser les 250 feuilles. Fractionnez le au préalable."
    Exit Sub
End If
'-------------------------------------------------------------'
'------ Création des feuilles nommées Famille_Ss Famille -----'
'-------------------------------------------------------------'
TablDico = DicoConcat.keys
'Si vous souhaitez tester si la feuille a déjà été créée
'enlevez les apostrophes en début des lignes suivantes
For i = 0 To UBound(TablDico) - 1
'    If FeuilleExiste(TablDico(i)) = False Then
        ThisWorkbook.Worksheets.Add
        With ActiveSheet
            .Name = TablDico(i)
            .Range("A1") = "Fournisseur"
            .Range("B1") = "Ref"
            .Range("C1") = "Description"
            .Range("D1") = "Prix"
            .Range("E1") = "Famille"
            .Range("F1") = "Sous famille"
'-------------------------------------------------------------'
'------ remplit les feuilles nommées Famille_Ss Famille ------'
'-------------------------------------------------------------'
            For j = 1 To UBound(concat)
                If concat(j) = TablDico(i) Then
                    Lig = .Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Row
                    For Col = 1 To 6
                        .Cells(Lig, Col) = Colonns(j, Col)
                    Next
                End If
            Next j
        End With
'    Else
'        With Sheets(concat)
'            .Cells.Clear
'        End With
'    End If
Next i
Sheets("Feuil1").Select
'-------------------------------------------------------------'
'---- Renomme les feuilles en fonction d'une liste Feuil2 ----'
'-------------------------------------------------------------'
test = False
Message = "Les feuilles suivantes n'ont pas pu être renommées : " & Chr(10)
For Each Wsh In ThisWorkbook.Worksheets
    With Sheets("Feuil2")
        Set Trouve = .Columns(1).Cells.Find(Wsh.Name, LookAt:=xlWhole)
            If Trouve Is Nothing Then
                Message = Message & Chr(10) & Wsh.Name
                test = True
            ElseIf Trouve.Offset(0, 1) <> "" Then
                If FeuilleExiste(Trouve.Offset(0, 1).Value) Then
                    Message = Message & Chr(10) & Trouve.Value
                    test = True
                Else
                    Wsh.Name = Trouve.Offset(0, 1).Value
                End If
            End If
        Set Trouve = Nothing
    End With
Next
If test = True Then
    MsgBox Message
Else
    MsgBox "Toutes les feuilles ont été renommées"
End If
End Sub

Function FeuilleExiste(NomFeuille) As Boolean
    Dim f As Object
    On Error Resume Next
    Set f = Sheets(NomFeuille)
    If Err = 0 Then FeuilleExiste = True
    Set f = Nothing
End Function

Sub ListeFamillesSousFamilles()
Dim DicoConcat As Object
Dim concat()
Dim DrLig As Long, i As Long, j As Long

Application.ScreenUpdating = False
With Sheets("Feuil1")
    DrLig = .Range("A" & Rows.Count).End(xlUp).Row
    ReDim concat(DrLig)
    For i = 2 To DrLig
        concat(i - 1) = .Cells(i, 5) & "_" & .Cells(i, 6)
    Next i
End With
Set DicoConcat = CreateObject("Scripting.Dictionary")
For i = LBound(concat) To UBound(concat)
    DicoConcat(concat(i)) = ""
Next i
With Sheets("Feuil2")
    .Range("A1").Resize(DicoConcat.Count) = Application.Transpose(DicoConcat.keys)
End With
End Sub

Dauphins · Answer

Ok mais cela ne renomme pas. Comment dois-je faire pour mettre les noms de remplacement et qu'il le fasse automatiquement ?

Dauphins · Answer

Cela ne fonctionne pas. Quand je lance Répartition, il m'ouvre une fenêtre me listant toutes les fenêtres n'ayant pas pu être renommées, bref toutes. Quand je la ferme il me tri quand même les références

N'est il pas possible que la fenêtre 2 sois déjà écrite dès le départ afin d'éviter aux personnes utilisant cela de tout faire à chaque fois a la main ?

Dauphins · Answer

Bonjour, je viens de réessayé et cela ne fonctionne pas. Je lance la première macro, dans la feuille 2 il me créait une liste en colonne A, donc en B je mets en face des noms, banane, pomme...
Je lance ensuite la deuxième macro et cela me produit une fenêtre pour m'indiquer que toute n'ont pas pu être renommée, et me fait le tri.

Est-il possible que dans le code tu mets par défaut 2_1 = banane.... ? Comme cela tout est automatique.

pijaku · Answer

Bonjour,

Problème résolu par MP, du à un souci sur les données, présence de caractères spéciaux dans les noms de feuilles...
La macro finale semble donc bien "tourner".
Voici son code, au cas ou... :

Option Explicit

Option Base 1


'+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++'
'----- SOURCES Pédagogiques :

    '- Pour les variables tableaux :
'http://boisgontierjacques.free.fr/pages_site/tableaux.htm
'http://silkyroad.developpez.com/vba/tableaux/

    '- Pour les objets Dictionary (merci Michel_m ;-)) :
'http://boisgontierjacques.free.fr/pages_site/Dictionnaire.htm

    '- Pour le tri des onglets :
'http://www.commentcamarche.net/forum/affich-3356070-vba-trier-les-feuilles#1

    'En général :
'http://www.commentcamarche.net/forum/

    'et en particulier pour la Function FeuilleExiste :
'http://www.developpez.net/forums/f542/logiciels/microsoft-office/excel/
'+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++'

Sub Repartition()
Dim DicoConcat As Object
Dim concat(), Colonns(), TablDico(), Symb()
Dim DrLig As Long, i As Long, j As Long, Lig As Long, Col As Long
Dim Boucle As Integer, Compteur As Integer
Dim Wsh As Worksheet
Dim Trouve As Range
Dim Message As String
Dim test As Boolean
Dim t

t = Timer
Application.ScreenUpdating = False
'------------------------------------------------------'
'------ Effacement des symboles colonne C Feuil1 ------'
'------------------------------------------------------'
Symb = Array(">", "<", "-", "+", "=", "$") 'tu peux ajouter ici autant de symboles que nécessaire!!!
With Sheets("Feuil1")
    DrLig = .Range("C" & Rows.Count).End(xlUp).Row
    For Lig = 1 To DrLig
        For i = LBound(Symb) To UBound(Symb)
            If InStr(.Cells(Lig, 3), Symb(i)) <> 0 Then
                .Cells(Lig, 3) = Replace(.Cells(Lig, 3), Symb(i), "")
            End If
        Next i
    Next Lig
'------------------------------------------------------------'
'-- remplissage des variables avec le contenu de la Feuil1 --'
'------------------------------------------------------------'
    DrLig = .Range("A" & Rows.Count).End(xlUp).Row
    ReDim concat(DrLig)
    ReDim Colonns(1 To DrLig, 1 To 6)
    For i = 2 To DrLig
        For j = 1 To 6
            'Colonns = toutes les données deFeuil1
            Colonns(i - 1, j) = .Cells(i, j)
        Next j
        'concat = concaténation des colonnes E & F
        concat(i - 1) = Colonns(i - 1, 5) & "_" & Colonns(i - 1, 6)
    Next i
End With
'-------------------------------------------------------------'
'-- Etablit la liste sans doublons des Familles_ss familles --'
'-------------------------------------------------------------'
Set DicoConcat = CreateObject("Scripting.Dictionary")
For i = LBound(concat) To UBound(concat)
    DicoConcat(concat(i)) = ""
Next i
'-------------------------------------------------------------'
'- Compte si le futur nombre de feuilles est supérieur à 250 -'
'-------------------------------------------------------------'
If DicoConcat.Count + ThisWorkbook.Worksheets.Count >= 250 Then
    MsgBox "Votre classeur va dépasser les 250 feuilles. Fractionnez le au préalable."
    Exit Sub
End If
'-------------------------------------------------------------'
'------ Création des feuilles nommées Famille_Ss Famille -----'
'-------------------------------------------------------------'
TablDico = DicoConcat.keys
For i = 0 To UBound(TablDico) - 1
'-------------------------------------------------------------'
'------ Cas d'une feuille déjà existante - TEST cf + bas -----'
'------ Si vous souhaitez ajouter ce test de sécurité à ------'
'------ la procédure, enlevez les ' en début des lignes ------'
'------ référencées par 'suppr(') en fin de ligne... ---------'
'-------------------------------------------------------------'
'    If FeuilleExiste(TablDico(i)) = False Then                                 'suppr(')
        ThisWorkbook.Worksheets.Add
        With ActiveSheet
            .Name = TablDico(i)
            .Range("A1") = "Fournisseur"
            .Range("B1") = "Ref"
            .Range("C1") = "Description"
            .Range("D1") = "Prix"
            .Range("E1") = "Famille"
            .Range("F1") = "Sous famille"
'-------------------------------------------------------------'
'------ remplit les feuilles nommées Famille_Ss Famille ------'
'-------------------------------------------------------------'
            For j = 1 To UBound(concat)
                If concat(j) = TablDico(i) Then
                    Lig = .Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Row
                    For Col = 1 To 6
                        .Cells(Lig, Col) = Colonns(j, Col)
                    Next
                End If
            Next j
        End With
'-------------------------------------------------------------'
'------ Cas d'une feuille déjà existante - Cf test + haut ----'
'--- On supprime tout ce qu'elle contenait et on la remplit --'
'-------------------------------------------------------------'
'    Else                                                                       'suppr(')
'        With Sheets(concat)                                                    'suppr(')
'            .Cells.Clear                                                       'suppr(')
'            .Range("A1") = "Fournisseur"                                       'suppr(')
'            .Range("B1") = "Ref"                                               'suppr(')
'            .Range("C1") = "Description"                                       'suppr(')
'            .Range("D1") = "Prix"                                              'suppr(')
'            .Range("E1") = "Famille"                                           'suppr(')
'            .Range("F1") = "Sous famille"                                      'suppr(')
'            For j = 1 To UBound(concat)                                        'suppr(')
'                If concat(j) = TablDico(i) Then                                'suppr(')
'                    Lig = .Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Row  'suppr(')
'                    For Col = 1 To 6                                           'suppr(')
'                        .Cells(Lig, Col) = Colonns(j, Col)                     'suppr(')
'                    Next                                                       'suppr(')
'                End If                                                         'suppr(')
'            Next j                                                             'suppr(')
'        End With                                                               'suppr(')
'    End If                                                                     'suppr(')
Next i
Sheets("Feuil1").Select
'-------------------------------------------------------------'
'---- Renomme les feuilles en fonction d'une liste Feuil2 ----'
'-------------------------------------------------------------'
test = False
Message = "Les feuilles suivantes n'ont pas pu être renommées : " & Chr(10)
For Each Wsh In ThisWorkbook.Worksheets
    With Sheets("Feuil2")
        Set Trouve = .Columns(1).Cells.Find(Wsh.Name, LookAt:=xlWhole)
            If Trouve Is Nothing Then
                Message = Message & Chr(10) & Wsh.Name
                test = True
            ElseIf Trouve.Offset(0, 1) <> "" Then
                If FeuilleExiste(Trouve.Offset(0, 1).Value) Then
                    Message = Message & Chr(10) & Trouve.Value
                    test = True
                Else
                    Wsh.Name = Trouve.Offset(0, 1).Value
                End If
            Else
                Message = Message & Chr(10) & Trouve.Value
                test = True
            End If
        Set Trouve = Nothing
    End With
Next
'-------------------------------------------------------------'
'-------- Trie les feuilles dans l'ordre alphabétique --------'
'-------------------------------------------------------------'
For Boucle = 1 To Sheets.Count
    If Sheets(Boucle).Visible = True Then
        For Compteur = 1 To (Boucle - 1)
            If Sheets(Compteur).Visible = True Then
                If (UCase(Sheets(Boucle).Name) < UCase(Sheets(Compteur).Name)) Then
                    Sheets(Boucle).Move before:=Sheets(Compteur)
                    Exit For
                End If
            End If
        Next Compteur
    End If
Next Boucle
Sheets("Feuil1").Select
'-------------------------------------------------------------'
'--------- Fin de la macro / message à l'utilisateur ---------'
'-------------------------------------------------------------'
If test = True Then
    MsgBox "Procédure terminée en : " & Timer - t & " Secondes!" & Chr(10) & Message
Else
    MsgBox "Procédure terminée en : " & Timer - t & " Secondes!" & Chr(10) & "Toutes les feuilles ont été renommées"
End If
End Sub

Function FeuilleExiste(NomFeuille) As Boolean
    Dim f As Object
    On Error Resume Next
    Set f = Sheets(NomFeuille)
    If Err = 0 Then FeuilleExiste = True
    Set f = Nothing
End Function

Tri en masse Excel 2007 - Page 2

Newsletters