Nommer onglet et tri d'onglet

[pittex]

Bonjour,

Je voudrais nommer les onglets en fonction du contenu d'une cellule et aprés faire un tri alphabetique des onglets.

Ex :

Contenu (Feuil1,Cellule C1) -> Renomme l'onglet Feuil1
Contenu (Feuil2,Cellule C1) -> Renomme l'onglet Feuil2
....

Merci de votre aide.

 

[XanorK]

Re : Nommer onglet et tri d'onglet

bonjour,


voici pour renommer les onglets :

Sub essai()
Dim I As Integer
For I = 1 To Sheets.Count
Sheets(I).Name = Sheets(I).[C1].Value
Next I
End Sub


XanorK

 

[XanorK]

Re : Nommer onglet et tri d'onglet

Et voila un morceau de code trouver sur internet.

L'astuce : creer un sommaire avec le nom de chaque feuil, puis trier ce tableau.

 

[pittex]

Re : Nommer onglet et tri d'onglet

Merci beaucoup pour les infos que tu m'as donné, ca fonctionne trés bien.

Je me permet d'encore abuser, en fait le text qui est ds la cellule C2 et de la forme :

- Prénom Nom - (le "-" est présent ds la cellule)

Et en fait je voudrais trier les onglet non pas par "prénom" mais par "nom".
Si tu pouvais encore m'aider je t'en serais trés reconnaissant. 😛

 

[lesarthois]

Re : Nommer onglet et tri d'onglet

bonsoir pittex , le forum

voici ce que tu cherche

Sub Nom_Onglet()
Dim NOM As String
NOM = Range("A2")
Application.ScreenUpdating = False
ActiveSheet.Name = (NOM)
End Sub




bon courage

 

[lesarthois]

Re : Nommer onglet et tri d'onglet

re, pittex , le forum

pourrait tu nous fournir un fichier svp

 

[lesarthois]

Re : Nommer onglet et tri d'onglet

oups
ceci

Sub TriChaqueFeuilles()
Dim X As Variant
Dim I As Variant
For Each X In ActiveWorkbook.Sheets
For I = 2 To ActiveWorkbook.Sheets.Count
If Sheets(I - 1).Name > Sheets(I).Name Then
Sheets(I - 1).Move After:=Sheets(I)
End If
Next
Next
End Sub

 

[XanorK]

Re : Nommer onglet et tri d'onglet

bonsoir,

Voici une solution qui ne marche QUE si il n'y a pas d'espace dans les prénoms.
il faut ecrire Jean-Paul au lieu de Jean paul et ca passe


Xanork

Edit : oups, coucou lesarthois, tu as repondu avant moi.

 

[pittex]

Re : Nommer onglet et tri d'onglet

Merci pour votre aide. Je ne peut malheuresement pas vous fournir le fichier sur lequel j'ai besoin de faire ces actions, c'est un fichier pour une amie qui doit faire des tri pour le travail.
J'ai tenté l'action de Lesarthois, mais le tri se fait tjs par "prenom" et pas par '"nom".
Autrement retirer l'éspace entre le nom et le prénom vu le volume de changement à réaliser, n'apporterais aucun gain de temps.

Je vous remerci pour votre aide, le document étant assez préssé, l'action se fera manuellement.

Encore merci a tous.

 

[Miro911]

Re : Nommer onglet et tri d'onglet

salut a tous

voici une macro faite par un ami les spécialistes du forum pourront sans doute adapter ce code à ton cas.

Public Sub Split_Ptf()

Dim lv_Reponse As Variant
Dim ls_Adress As String
Dim ls_Ptf() As String
Dim lb_Found As Boolean
Dim ll_Cpt As Long
Dim ls_WksCur As String

Application.ScreenUpdating = False 'Suppression de la visualisation de l'avancement

On Error GoTo ErrorHandler 'Gestion d'erreur

Application.Calculation = xlManual
ReDim ls_Ptf(0)
lv_Reponse = MsgBox("Etes-vous bien sur la première ligne de la colonne à spliter?", vbYesNoCancel)

If lv_Reponse = vbCancel Or lv_Reponse = vbNo Then
GoTo Free_Mem
End If

ls_Adress = ActiveCell.Address
ls_WksCur = ActiveSheet.Name

'Gestion de la barre de statut
Application.StatusBar = "Lecture des différentes valeurs à splitter..."

While ActiveCell.Value <> ""
lb_Found = False
For ll_Cpt = 1 To UBound(ls_Ptf)
If ls_Ptf(ll_Cpt) = Trim(ActiveCell.Value) Then
lb_Found = True
Exit For
End If
Next

If Not lb_Found Then
ReDim Preserve ls_Ptf(UBound(ls_Ptf) + 1)
ls_Ptf(UBound(ls_Ptf)) = Trim(ActiveCell.Value)
End If
ActiveCell.Offset(1, 0).Select
Wend
Range(ls_Adress).Select

For ll_Cpt = 1 To UBound(ls_Ptf)
'Gestion de la barre de statut
Application.StatusBar = "Traitement de " & ls_Ptf(ll_Cpt)
Sheets(ls_WksCur).Select
Sheets(ls_WksCur).Copy Before:=Sheets(ls_WksCur)

On Error Resume Next
ActiveSheet.Name = ls_Ptf(ll_Cpt) 'Sheets("Sheet1 (2)").Name = "GLB_OBL_BEF"
'Suppression de la feuille si elle existe déjà
If Err.Number <> 0 Then
Application.DisplayAlerts = False
Sheets(ls_Ptf(ll_Cpt)).Delete
Application.DisplayAlerts = True
ActiveSheet.Name = ReplaceString(ReplaceString(ls_Ptf(ll_Cpt), "%", ""), "/", "")
End If
On Error GoTo ErrorHandler
Range(ls_Adress).Select
While ActiveCell.Value <> ""
If Trim(ActiveCell.Value) = ls_Ptf(ll_Cpt) Then
ActiveCell.Offset(1, 0).Select
Else
Selection.EntireRow.Delete
End If
Wend
Range(ls_Adress).Select
Next

Range(ls_Adress).Select
Sheets(ls_WksCur).Select
Range(ls_Adress).Select

GoTo Free_Mem

ErrorHandler:
'Gestion d'erreur simple
MsgBox Err.Number & " / " & Err.Description

Free_Mem:
ReDim ls_Ptf(0)
Application.Calculation = xlAutomatic
'Gestion de la barre de statut
Application.StatusBar = False
End Sub

Public Function ReplaceString(ByVal as_String As String, as_Replaced As String, as_Replace As String) As String
Dim li_pos As Integer
li_pos = 1
Do Until li_pos = 0
li_pos = InStr(as_String, as_Replaced)
If li_pos > 0 Then
as_String = Left(as_String, li_pos - 1) & as_Replace & Mid(as_String, Len(as_Replaced) + li_pos)
End If
Loop
ReplaceString = as_String
End Function




a plus

 

[Miro911]

Re : Nommer onglet et tri d'onglet

Re salut
je crois que le code que g mis sur le forum est hors propos

toutes mes excuses j'avais bien une macro pour faire cela mais je ne l'a trouve plus
désolé

 

[Miro911]

Re : Nommer onglet et tri d'onglet

Voici une solution pour trier automatiquement les feuilles

Public Sub Ordonne_Sheets()
' Auteur : Dransart Olivier
' **************************
Dim ll_Cpt As Long
Dim ll_Cpt1 As Long
Dim ls_NomWks() As String
Dim lw_Wks As Worksheet
Dim ls_Tri As String

ReDim ls_NomWks(0)

'Lecture
For Each lw_Wks In ActiveWorkbook.Worksheets
ReDim Preserve ls_NomWks(UBound(ls_NomWks) + 1)
ls_NomWks(UBound(ls_NomWks)) = lw_Wks.Name
Next

'Tri
For ll_Cpt = 1 To UBound(ls_NomWks) - 1
For ll_Cpt1 = ll_Cpt + 1 To UBound(ls_NomWks)
If UCase(ls_NomWks(ll_Cpt)) > UCase(ls_NomWks(ll_Cpt1)) Then
ls_Tri = ls_NomWks(ll_Cpt)
ls_NomWks(ll_Cpt) = ls_NomWks(ll_Cpt1)
ls_NomWks(ll_Cpt1) = ls_Tri
End If
Next
Next

'Déplacements
For ll_Cpt = 1 To UBound(ls_NomWks)
Sheets(ls_NomWks(ll_Cpt)).Move Before:=Sheets(ll_Cpt)
Next

MsgBox "Attention, il se peut que la dernière feuille ne soit pas triée", vbInformation

End Sub


Ce code n'est pas de moi je suis pas à ce niveau a plus