Répéter des valeurs de cellule en fonction de sa feuille précédente en VBA

Heureusement que des gens comme vous existe!!

Et bien j'aimerais retrouvé les codes couleurs et les formules d'après la macro qui ne sert à rien..

'For Each ws In Worksheets 'pour chaque feuille
   ' typ = ws.Range("E4").Value 'typ = valeur en E4
    'Select Case typ 'sélectionner selon valeur de typ
        'Case "FORFAIT": ws.Tab.ColorIndex = 44 'forfait, couleur orange
        'Case "JOUR", "LA JOURNEE": ws.Tab.ColorIndex = 43 'etc
        'Case "NUIT / WEEK-END": ws.Tab.ColorIndex = 3
        'Case "Modèle": ws.Tab.ColorIndex = 5
    'End Select

Oui c'est bien ça, c'est un peu de même style mais plus complexe..

Je ne comprends pas ce que tu voudrais. Ici, j'ai juste modifié ta macro de manière à avoir un select case plutôt qu'une succession de if. C'était purement esthétique.

Une fois que cette macro est exécutée (ces opérations peuvent facilement être effectuées à la main d'ailleurs), la macro ne sert plus à rien, à moins que les couleurs d'onglets ne changent à nouveau, ce dont je doute.

Ici, la couleur est exprimée d'après son index dans la table des couleurs. Voici un lien qui permet d'avoir les conversions :

https://www.excelsupersite.com/what-are-the-56-colorindex-colors-in-excel/

Bonjour,

Oui c'est ça cependant il y a deux formule de couleur si je lis bien dans le module entier. Il y a en haut ce que tu pense etre inutile avec les selectcase et en bas ce qu'on a rajouter avec les (255.0.0) ca fait des doublons non?

Alors je me suis permis de modifié le code, cependant il est beaucoup plus long a me construire les feuilles est ce normal?

Sub Ajouter_Feuilles()

Dim J As Long
Dim ws As Worksheet
Dim typ As String

With Sheets("Modèle") '<<< adapter (j'ai restructuré le fichier de base)
    For J = 1 To .Range("A" & .Rows.Count).End(xlUp).Row 'pour chaque cellule de la liste
        If Not FeuilleExiste(.Range("A" & J).Value) Then 'si le nom de feuille n'existe pas
            Sheets("Modèle").Copy after:=Sheets(Sheets.Count) 'copie modele en dernier
            With Sheets(Sheets.Count) 'avec la dernière feuille (ou activesheet)
                .Name = .Range("A" & J) 'nom = AJ de feuille liste
                .Range("E3") = .Range("A" & J) 'E3 = AJ de feuille liste
            End With
        End If
    Next J
End With

'Sub Couleuronglet()
For Each ws In Worksheets 'pour chaque feuille
    If ws.Name Like "*J" Then 'si nom feuille termine par J
        'ws.Tab.Color = RGB(0, 255, 0)
        ws.Tab.ColorIndex = 43
        End If
        If ws.Name Like "*NW" Then
        ws.Tab.ColorIndex = 3
    End If

    If ws.Name Like "Modèle" Then
        ws.Tab.ColorIndex = 5
    End If
    If ws.Name Like "Liste*" Then
        ws.Tab.ColorIndex = 5
    End If

    typ = ws.Range("E4").Value 'typ = valeur en E4
    Select Case typ 'sélectionner selon valeur de typ
        Case "FORFAIT": ws.Tab.ColorIndex = 44 'forfait, couleur orange
        Case "LA JOURNEE": ws.Tab.ColorIndex = 43 'etc
    End Select

'End Sub

'<<<<<MACRO INADAPTÉE OU INUTILE A TERME CAR ONGLETS FIXES APPAREMMENT
'----------------------------------------
'Sub Couleuronglet()
'
'Dim ws As Worksheet
'Dim typ As String

'For Each ws In Worksheets 'pour chaque feuille
    'typ = ws.Range("E4").Value 'typ = valeur en E4
    'Select Case typ 'sélectionner selon valeur de typ
        'Case "FORFAIT": ws.Tab.ColorIndex = 44 'forfait, couleur orange
        'Case "JOUR", "LA JOURNEE": ws.Tab.ColorIndex = 43 'etc
        'Case "NUIT / WEEK-END": ws.Tab.ColorIndex = 3
        'Case "Modèle": ws.Tab.ColorIndex = 5
    'End Select
Next

End Sub
'-----------------------------------------

Sub testvaleur()

Dim ws As Worksheet
Dim nomdest$
Dim adresses
Dim i%

adresses = Array("D9:D12", "D14:D22", "B24:D31", "I24:I31", "L14:L22", "L24:L31")

For Each ws In Worksheets 'pour chaque feuille
    If ws.Name Like "*J" Then 'si nom feuille termine par J
        'ws.Tab.Color = RGB(0, 255, 0)
        'ws.Tab.ColorIndex = 43
        nomdest = Replace(ws.Name, "J", "NW") 'nom feuille destination = nom ws avec J remplacé par NW
        For i = 0 To UBound(adresses)
            If FeuilleExiste(nomdest) Then 'si la feuille de destination existe
                ws.Range(adresses(i)).Copy Destination:=Sheets(nomdest).Range(adresses(i))  'NW prend valeurs J
            End If
        Next i
    End If
    'If ws.Name Like "*NW" Then
        'ws.Tab.Color = RGB(255, 0, 0)
        'ws.Tab.ColorIndex = 3
    'End If
    'If ws.Name Like "Modèle" & "Liste BP" Then
        'ws.Tab.Color = RGB(255, 0, 0)
        'ws.Tab.ColorIndex = 5
    'End If
Next ws

End Sub

Function FeuilleExiste(nomfeuille As String) As Boolean
Dim ws As Worksheet
For Each ws In Worksheets
    If ws.Name = nomfeuille Then
        FeuilleExiste = True
        Exit Function
    End If
Next ws
End Function

Salut Willkaa,

Alors pardonne-moi, mais comme souvent, j'ai parlé un peu vite car le code que j'ai jugé inutilé colorie les feuilles en fonction de la valeur de E4 et non du nom de la feuille...

Donc finalement, il a un intérêt je pense.

Par contre, cette partie peut-être sacrifiée ou améliorée :

For Each ws In Worksheets 'pour chaque feuille
    If ws.Name Like "*J" Then 'si nom feuille termine par J
        'ws.Tab.Color = RGB(0, 255, 0)
        ws.Tab.ColorIndex = 43 '<<<< intérêt limité surtout si J ou NW est créé à parti de modèle : on change la couleur au moment de la création ???
        End If
        If ws.Name Like "*NW" Then '<<<< idem
        ws.Tab.ColorIndex = 3
    End If

    If ws.Name Like "Modèle" Then 'aucun intérêt car ne change pas
        ws.Tab.ColorIndex = 5
    End If
    If ws.Name Like "Liste*" Then 'intérêt ???
        ws.Tab.ColorIndex = 5
    End If

Alors, ça peut prendre plus de temps pour plusieurs raisons mais il y a quand même 2 boucles et plus le nombre de feuilles augmentera donc plus la colonne A sera étendue, plus ce sera long...

Tant que possible, il faut éviter de faire des doublons de boucle.

Bonjour 3GB,

Merci de ton retour,

Dans ce cas je la remettrai en fonction,

Ce qui est bien c'est que je commence à savoir lire les codes :)

Très bien je prend note de tout cela

Merci encore!