Cattleya97
XLDnaute Nouveau
Bonjour
je suis en quête de réponse, j'ai cherchée un peu partout sur internet mais je n'arrive pas à obtenir la totalité de ce que je recherche.
J'ai un classeur qui contient plusieurs onglets nommée par agent , je souhaite mettre une macro qui me permettrait de :
- mettre mes différentes feuilles sur un onglet nom (1-sommaire) avec une liaison sur chacune d'elles
-trier par ordre alphabétique sachant que j'ai des agents qui peuvent avoir le même nom (A savoir que mon fichier est évolutif je peux être amener à ajouter d'autres feuilles )
J'ai du coup mis 2 modules mais lorsque je vais sur certains liens ils ne fonctionnent pas ( je pense que c'est par rapport au tiret ou espace dans le nom des feuilles mais comment faire pour différencier 2 personnes aux mêmes noms? Est ce un problème de macro qui pourrait comporter une ligne avec cette informtion?
en vous remerciant pour votre aide.
La première (sommaire)
Sub sommaire()
Dim feuille(500)
a = 0
For Each sh In Sheets
feuille(a) = sh.Name
a = a + 1
Next
Sheets("1-sommaire").Cells(1, 1).Value = "SOMMAIRE DU CLASSEUR"
For i = 1 To a - 1
Sheets("1-sommaire").Hyperlinks.Add Anchor:=Sheets("1-sommaire").Cells(i + 2, 1), Address:="", SubAddress:= _
feuille(i) & "!A1", TextToDisplay:=feuille(i)
Next i
Sheets("1-sommaire").Activate
End Sub
La deuxième (tri)
Public Sub TrierFeuilles()
On Error GoTo TriageErreur
Dim j As Integer
Dim i As Integer
Dim PremiereFeuille As Integer
Dim DerniereFeuille As Integer
PremiereFeuille = 1
DerniereFeuille = ActiveWorkbook.Worksheets.Count
For i = PremiereFeuille To DerniereFeuille
For j = i To DerniereFeuille
If UCase(SupprimerDiacritique(Worksheets(j).Name)) < UCase(SupprimerDiacritique(Worksheets(i).Name)) Then
Worksheets(j).Move Before:=Worksheets(i)
End If
Next j
Next i
Exit Sub
TriageErreur:
'Erreur
End Sub
Function SupprimerDiacritique(Texte As String)
Dim LettreD As String
Dim LettreN As String
Dim TexteTemporaire As String
Dim i As Long
Const LettresDiacritique = "ÀÁÂÃÄÅÇÈÉÊËÌÍÎÏÑÒÓÔÕÖÙÚÛÜÝŸàáâãäåçèéêëìíîïñòóôõöùúûüýÿ"
Const LettresNormales = "AAAAAACEEEEIIIINOOOOOUUUUYYaaaaaaceeeeiiiinooooouuuuyy"
TexteTemporaire = Texte
For i = 1 To Len(LettresDiacritique)
LettreD = Mid(LettresDiacritique, i, 1)
LettreN = Mid(LettresNormales, i, 1)
TexteTemporaire = Replace(TexteTemporaire, LettreD, LettreN)
Next
SupprimerDiacritique = TexteTemporaire
End Function
je suis en quête de réponse, j'ai cherchée un peu partout sur internet mais je n'arrive pas à obtenir la totalité de ce que je recherche.
J'ai un classeur qui contient plusieurs onglets nommée par agent , je souhaite mettre une macro qui me permettrait de :
- mettre mes différentes feuilles sur un onglet nom (1-sommaire) avec une liaison sur chacune d'elles
-trier par ordre alphabétique sachant que j'ai des agents qui peuvent avoir le même nom (A savoir que mon fichier est évolutif je peux être amener à ajouter d'autres feuilles )
J'ai du coup mis 2 modules mais lorsque je vais sur certains liens ils ne fonctionnent pas ( je pense que c'est par rapport au tiret ou espace dans le nom des feuilles mais comment faire pour différencier 2 personnes aux mêmes noms? Est ce un problème de macro qui pourrait comporter une ligne avec cette informtion?
en vous remerciant pour votre aide.
La première (sommaire)
Sub sommaire()
Dim feuille(500)
a = 0
For Each sh In Sheets
feuille(a) = sh.Name
a = a + 1
Next
Sheets("1-sommaire").Cells(1, 1).Value = "SOMMAIRE DU CLASSEUR"
For i = 1 To a - 1
Sheets("1-sommaire").Hyperlinks.Add Anchor:=Sheets("1-sommaire").Cells(i + 2, 1), Address:="", SubAddress:= _
feuille(i) & "!A1", TextToDisplay:=feuille(i)
Next i
Sheets("1-sommaire").Activate
End Sub
La deuxième (tri)
Public Sub TrierFeuilles()
On Error GoTo TriageErreur
Dim j As Integer
Dim i As Integer
Dim PremiereFeuille As Integer
Dim DerniereFeuille As Integer
PremiereFeuille = 1
DerniereFeuille = ActiveWorkbook.Worksheets.Count
For i = PremiereFeuille To DerniereFeuille
For j = i To DerniereFeuille
If UCase(SupprimerDiacritique(Worksheets(j).Name)) < UCase(SupprimerDiacritique(Worksheets(i).Name)) Then
Worksheets(j).Move Before:=Worksheets(i)
End If
Next j
Next i
Exit Sub
TriageErreur:
'Erreur
End Sub
Function SupprimerDiacritique(Texte As String)
Dim LettreD As String
Dim LettreN As String
Dim TexteTemporaire As String
Dim i As Long
Const LettresDiacritique = "ÀÁÂÃÄÅÇÈÉÊËÌÍÎÏÑÒÓÔÕÖÙÚÛÜÝŸàáâãäåçèéêëìíîïñòóôõöùúûüýÿ"
Const LettresNormales = "AAAAAACEEEEIIIINOOOOOUUUUYYaaaaaaceeeeiiiinooooouuuuyy"
TexteTemporaire = Texte
For i = 1 To Len(LettresDiacritique)
LettreD = Mid(LettresDiacritique, i, 1)
LettreN = Mid(LettresNormales, i, 1)
TexteTemporaire = Replace(TexteTemporaire, LettreD, LettreN)
Next
SupprimerDiacritique = TexteTemporaire
End Function