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