Excel: Deplacer et re-arranger des feuilles

Résolu
Chplain Messages postés 2 Statut Membre -  
Chplain Messages postés 2 Statut Membre -
Bonjour,

Voici mon probleme, j'ai un classeur excel comportant les feuilles suivantes:

- LISTE
- Feuille 1
- Feuille 2
- Feuille 3
- Feuille 4
....

Dans chacune de ces feuilles, se trouve une valeur numerique quelconque sur une case identique ( par example A1: Colonne A, Ligne 1).

Maintenant, je voudrai ajouter un bouton commande sur la feuille nommee LISTE ( Ca, je peux le faire ), qui par un simple click, m'aidera a deplacer et repositioner automatiquement les feuilles dans un ordre croissant ( ou decroissant ) en fonction de leur valeur numerique se trouvant dans la case A1.

Y a t'il une fonction macro applicable?

Je travaille sur Excell 2003, merci
A voir également:

2 réponses

Réponse 1 / 2
Chplain Messages postés 2 Statut Membre
 
Michel, merci infinement
0
Réponse 2 / 2
michel_m Messages postés 18903 Statut Contributeur 3 318
 
Bonjour

tri dans l'ordre décroissant de A5 dans feuil1,2,3....N
"liste" doit être en premier 

Option Explicit
Sub ranger()
Dim tablo()
Dim nbre As Byte, cptr As Byte, i As Byte, j As Byte, k As Byte
Dim tmp0 As Double, tmp1 As String
' nombre de feuilles
nbre = ThisWorkbook.Sheets.Count - 1

'construit un tableau 2 dimension et "nbre" d'éléments
ReDim tablo(nbre - 1, 1)

'remplit le tableau avec le nom des onglets et la valeur en A5
Do Until cptr = nbre
    tablo(cptr, 0) = Sheets("feuil" & cptr + 1).Range("A5").Value
    tablo(cptr, 1) = Sheets("feuil" & cptr + 1).Name
    cptr = cptr + 1
Loop

'range le tableau dans l'ordre croissant de A5
For i = 0 To nbre
        j = i
        For k = j + 1 To nbre - 1
            If tablo(k, 0) <= tablo(j, 0) Then j = k
        Next k
    If i <> j Then
        tmp0 = tablo(j, 0)
        tmp1 = tablo(j, 1)
        tablo(j, 0) = tablo(i, 0)
        tablo(j, 1) = tablo(i, 1)
        tablo(i, 0) = tmp0
        tablo(i, 1) = tmp1
    End If
  Next i
  
  'fige défilement de l'écran
  Application.ScreenUpdating = False
  'range les feuilles dans l'ordre décroissant de A5
 cptr = 0
 For cptr = 0 To UBound(tablo)
    Sheets(tablo(cptr, 1)).Move before:=Sheets(2)
Next
  
End Sub


demo:
http://www.cijoint.fr/cjlink.php?file=cj201006/cijLLXxaOe.xls
-1