Macro Triage d'onglet, création d'hyperlien etc

Bonjour,

J 'ai fais un code pour insérer un onglet dans un tableur.

Pour l 'instant, ma macro copie un onglet "template", une fenetre ouvre pour y insérer le nom de l'onglet, le nom est copié dans une cellule de la feuille et finalement, une couleur est associé à cette onglet.

Ce n 'est pas beaucoup de code et je me suis passablement débrouillé avec ce que j'ai trouvé sur internet.

Maintenant mon défi est que j'aimerais que le nom de ce nouvel onglet soit ajouté à la suite de ceux déjà inscrit dans une liste, ainsi que l'hyperlien qui dirige vers celui-ci.

Aussi, au lieu d'avoir le nouvel onglet à la fin, j'aimerais qu'il se retrouve a la suite des onglets de même couleur.

Sub New_driver()
'Creer un nouveau livreur

  Dim NewName As String
Another:
    OneMore = False
    NewName = InputBox("Nom du nouvel employé")
    ThisWorkbook.Sheets("Template").Copy _
    After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
    'Set NewSheet = Sheets.Add(After:=Sheets(Worksheets.Count), Count:=1, Type:=xlWorksheet)
    ActiveSheet.Tab.Color = vbBlue
    ActiveSheet.Name = NewName
    If MsgBox("Ajouter un autre employé?", vbYesNo) = 6 Then GoTo Another
    Sheets("Menu").Select

End Sub

Bonsoir,

Pour le déplacer vers sa couleur, tu ajoutes une variable i% à tes déclarations. Et tu insères après avoir nommé ton onglet :

For i = Sheets.Count - 1 To 1 Step -1
        If Sheets(i).Tab.Color = vbBlue Then
            ActiveSheet.Move after:=Sheets(i)
            Exit For
        End If
    Next i

Pour l'autre question, on ne peut deviner où sont les éléments que tu indiques...

Cordialement

Ferrand

Merci Ferrand! Ça fonctionnne bien.

J'ai trouvé comment placé le lien à la suite de ma liste. J'avais simplement a indiquer la plage de cellule.

Sub New_driver()
'Creer un nouveau livreur

  Dim NewName As String
Another:
    OneMore = False
    NewName = InputBox("Nom du nouvel employé")
    ThisWorkbook.Sheets("Template").Copy _
    after:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)

    For i = Sheets.Count - 1 To 1 Step -1
        If Sheets(i).Tab.Color = vbBlue Then
            ActiveSheet.Move after:=Sheets(i)
            Exit For
        End If
    Next i
    ActiveSheet.Tab.Color = vbBlue
    ActiveSheet.Name = NewName
    Sheets("Menu").Select
    ' find the first blank cell in a range
    Range("D12:D31").End(xlDown).Offset(1, 0).Select
    'moving
    ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:=NewName, SubAddress:= _
        "", TextToDisplay:=""
    If MsgBox("Ajouter un autre employé?", vbYesNo) = 6 Then GoTo Another
    Sheets("Menu").Select

End Sub