Tri

[David68]

Bonjour,

Sauriez vous m'indiquer la marche à suivre afin de classer de maniere automatique par ordre alphabétique toutes les feuilles de mon classeur. Merci d'avance.

 

[Hervé]

Bonsoir

une approche à placer dans un objet feuille :

Public Sub vev()
Dim i As Integer, l As Integer
Dim ws As Object
Dim c As Range
Dim feuille As String

Application.ScreenUpdating = False

feuille = ActiveSheet.Name
i = 1
For Each ws In Worksheets
Range("a" & i).Value = ws.Name
i = i + 1
Next ws

Columns("A:A").Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal

l = 1
For Each c In Range("a1:a" & Range("a65000").End(xlUp).Row)
Sheets(c.Text).Move after:=Worksheets(l)
l = l + 1
Next c
Sheets(feuille).Move before:=Worksheets(1)
Application.ScreenUpdating = True


End Sub

On passe par l'écriture sur la feuille active, du nom des feuilles, puis on les trie et ensuite on les range.

on doit pouvoir éviter l'écriture du nom des feuilles, en passant par un tableau (si ca t'intérresse, fait le savoir).

Salut
Hervé

 

[Hervé]

re

une autre solution par tableau dynamique :

Option Explicit
Public Sub trieronglet()
Dim j As Byte, i As Byte, l As Byte
Dim ws As Object
Dim test As Boolean
Dim feuille As String
Dim temp
ReDim nom(1 To Sheets.Count)
feuille = ActiveSheet.Name

j = 1
For Each ws In Worksheets
nom(j) = ws.Name
j = j + 1
Next ws

'inspiré de la page wiki de zon
Do
test = False
For i = LBound(nom) To UBound(nom) - 1
If (nom(i) > nom(i + 1)) Then
temp = nom(i)
nom(i) = nom(i + 1)
nom(i + 1) = temp
test = True
End If
Next i
Loop Until Not test


l = 1
For i = LBound(nom) To UBound(nom) - 1
Sheets(nom(i)).Move after:=Worksheets(l)
l = l + 1
Next i
Sheets(feuille).Select
End Sub


Salut
Hervé

 

[Mytå]

Bonsoir le forum

Et dans un module


Sub TrierFeuilles()

Dim I As Integer, J As Integer, K As Integer
Application.ScreenUpdating = False
For I = 1 To Sheets.Count
J = I
For K = I + 1 To Sheets.Count
If Sheets(K).Name < Sheets(J).Name Then J = K
Next K
If J <> I Then Sheets(J).Move Sheets(I)
Next I
End Sub

Mytå