Transfert format d'un onglet source vers plus de 50 onglets...

  • Initiateur de la discussion Initiateur de la discussion Urdi
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

U

Urdi

Guest
Bonjour,

j'ai besoin de vous!!

Depuis plusieurs jours je fais de multiples recherches sans trouver de réponse applicable à mon problème.

Je souhaiterai que lorsque je modifie la couleur de fond, de police ou la taille de police (Gras ou 12, 14) dans l'onglet "formulaire", les changement soit répercuté automatiquement (sans bouton si possible), vers les quelques dizaines d'onglet ("semaine 1, 2, 3... 52-53")

Avec comme difficulté supplémentaire que l'origine est une liste et que l'arrivé est une ligne fini.

Merci pour votre aide.
 

Pièces jointes

Re : Transfert format d'un onglet source vers plus de 50 onglets...

Bonjour,

En feuille Formulaire déplacer le tableau au même endroit que dans les autres feuilles (ou le contraire) de sorte que le "vasculaire" soit en B5.
Clic droit sur un onglet et "sélectionner tous les onglets".

Toute modification sur l'une des feuilles sera transposée sur toutes les feuilles.
Si certaines modifications ne doivent pas apparaître sur la feuille Formulaire, les effacer après avoir déselectionner toutes les feuilles


abcd
 
Dernière édition:
Re : Transfert format d'un onglet source vers plus de 50 onglets...

Merci pour cette réponse.. mais en fait je souhaiterai passer par VBA ou macro, pour éviter aux utilisateurs cette manipulation... alors les VBAïste?!

Je pensais à un code avec cette structure:

Pour chaque celllules de la liste:

recupérer la couleur, le format et le mettre dans une valeur et apliquer à la ligne correspondante (en indiquant les coordonnées de la première ligne et ensuite de descendre de 1 pour la suivante) et ensuite re-boucle pour application dans chaque onglet.

Le seul soucis c'est pour le traduire en VBA ...
 
Dernière modification par un modérateur:
Re : Transfert format d'un onglet source vers plus de 50 onglets...

Bonsoir Urdi, abcd,

Je te propose ce code à mettre dans le code de la feuille "Formulaire" en faisant bouton droit sur l'onglet puis visualiser le code:

Code:
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
If Not Intersect(Target, Range("B11:B28")) Is Nothing Then
  For i = 2 To Sheets.Count
    With Sheets(i)
      Set trouve = .Columns(2).Find(Target.Value, LookIn:=xlValues, lookat:=xlWhole)
      If Not trouve Is Nothing Then
        With trouve.Resize(1, 22).Font
          .Name = Target.Font.Name
          .FontStyle = Target.Font.FontStyle
          .Size = Target.Font.Size
          .ColorIndex = Target.Font.ColorIndex
        End With
        trouve.Resize(1, 22).Interior.ColorIndex = Target.Interior.ColorIndex
      End If
    End With
  Next
End If

End Sub
C'est une macro événementielle qui s'exécute après avoir fait les modifications de mise en forme voulu puis en cliquant bouton droit sur la cellule modifiée.
 
Dernière édition:
Re : Transfert format d'un onglet source vers plus de 50 onglets...

Bonjour Urdi,

Le problème, c'est qu'à ma connaissance, le changement de format n'est pas lié à un évènement (au sens VBA).

Je vois à priori 2 solutions :

1) Un lancement de la macro, traitant tous les onglets, par bouton ou par double clic dans la feuille "Formulaire".

2) Un lancement de la macro, traitant un seul onglet, quand cet onglet est activé. Mais il faut mettre une petite macro (3 lignes, toujours les mêmes) dans toutes les feuilles des semaines.

Merci de nous dire quelle solution vous préférez.

A+

Edit : salut skoobi, t'as choisi la solution 1)
 
Dernière édition:
Re : Transfert format d'un onglet source vers plus de 50 onglets...

je crois que je vais prendre l'option avec le bouton je test tout ça et je vous tiens au courant,...dans les minutes à venir. En tout cas merci pour la célérité de vos réponses!!!! Chapeau-bas.

Après test:

Un super bon point à tout les deux (Skoobi et job75).

Seul bémol, grace à vos éclaircissement j'affinerai bien ma demande (pour améliorer l'ergonomie) en optant pour un bouton "Cliquer ici pour mise à jour des onglet semaine".

Seul problème j'imagine que le code va être sensiblement différent puisqu'il va devoir recupérer chaque format de chaque cellule de la liste avant l'application de la modification dans les onglets...
 
Dernière modification par un modérateur:
Re : Transfert format d'un onglet source vers plus de 50 onglets...

Regardez!!!

Je suis un bon petit PadaWan non??

Code:
Private Sub Worksheet_Change(ByVal Target As Range)

Dim Cel As Range

For Each Cel In Range("liste_spe")

    If Not Intersect(Target, Range("liste_spe")) Is Nothing Then
      For i = 3 To 9 'de 3 à 9 correspond aux n° d'onglet sheets.count si on connais pas le dernier onglet
        With Sheets(i)
          Set trouve = .Columns(2).Find(Cel.Value, LookIn:=xlValues, lookat:=xlWhole) '2 correspond à un commencement en B du tableau à modifier
          If Not trouve Is Nothing Then
            With trouve.Resize(1, 22).Font '22 nombre de cellule de longueur à modifier
              .Name = Cel.Font.Name
              .FontStyle = Cel.Font.FontStyle
              .Size = Cel.Font.Size
              .ColorIndex = Cel.Font.ColorIndex
            End With
            trouve.Resize(1, 22).Interior.ColorIndex = Cel.Interior.ColorIndex
          End If
        End With
      Next
    End If

Next

End Sub

Bon me reste juste à trouver le moyen de lier le bouton à ce code....
 
Dernière modification par un modérateur:
Re : Transfert format d'un onglet source vers plus de 50 onglets...

Re,
salut job75 🙂,

c'est presque ça.
Enlève la première condition qui est valable uniquement pour une macro évenementielle:

Code:
Dim Cel As Range

For Each Cel In Range("liste_spe")

 [B][COLOR=Red]   If Not Intersect(Target, Range("liste_spe")) Is Nothing Then[/COLOR][/B]
      For i = 3 To 9 'de 3 à 9 correspond aux n° d'onglet sheets.count si on connais pas le dernier onglet
        With Sheets(i)
          Set trouve = .Columns(2).Find(Cel.Value, LookIn:=xlValues, lookat:=xlWhole) '2 correspond à un commencement en B du tableau à modifier
          If Not trouve Is Nothing Then
            With trouve.Resize(1, 22).Font '22 nombre de cellule de longueur à modifier
              .Name = Cel.Font.Name
              .FontStyle = Cel.Font.FontStyle
              .Size = Cel.Font.Size
              .ColorIndex = Cel.Font.ColorIndex
            End With
            trouve.Resize(1, 22).Interior.ColorIndex = Cel.Interior.ColorIndex
          End If
        End With
      Next
[COLOR=Red][B]    End If[/B][/COLOR]

Next

Et met le code dans un bouton 😉.
 
Re : Transfert format d'un onglet source vers plus de 50 onglets...

Ok, je comprends mieu...

Merci Beaucoup, je crois que je deviens accros au Macro/VBA, Merci encore à VOUS!!!!!

PS: je vais tester, mais bon je me doute que ça va fonctionner 😉

Pour résumer voici le code final:

Code:
Sub Maj_modif_liste_spe()
Dim Cel As Range

For Each Cel In Range("liste_spe")


      For i = 3 To 9 'de 3 à 9 correspond aux n° d'onglet à modifier -- mettre sheets.count à la place de 9 si on connais pas le dernier onglet
        With Sheets(i)
          Set trouve = .Columns(2).Find(Cel.Value, LookIn:=xlValues, lookat:=xlWhole) '2 correspond à un commencement en B du tableau à modifier
          If Not trouve Is Nothing Then
            With trouve.Resize(1, 22).Font '22 nombre de cellule de longueur à modifier
              .Name = Cel.Font.Name
              .FontStyle = Cel.Font.FontStyle
              .Size = Cel.Font.Size
              .ColorIndex = Cel.Font.ColorIndex
            End With
            trouve.Resize(1, 22).Interior.ColorIndex = Cel.Interior.ColorIndex
          End If
        End With
      Next


Next
End Sub
Ce code doit être collé dans un module pour être accessible par le bouton.
Vous créez le bonton, puis clic droit et "affecter une macro" et vous choisissez "Maj_modif_liste_spe" (c'est le nom de la macro) et voilou...

Merci encore...
 
Dernière modification par un modérateur:
Re : Transfert format d'un onglet source vers plus de 50 onglets...

Re,

Bravo Urdi, c'est parfait.

De mon côté, plutot qu'un bouton, je propose simplement de cliquer (sélection) sur la cellule C10 pour lancer la macro.

Voici le code et le fichier :

Code:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Intersect(Target, Range("C10")) Is Nothing Then Exit Sub
For Each Target In Range("B11:B28")
  For i = 2 To Sheets.Count
    With Sheets(i)
      Set trouve = .Columns(2).Find(Target.Value, LookIn:=xlValues, lookat:=xlWhole)
      If Not trouve Is Nothing Then
        With trouve.Resize(1, 22).Font
          .Name = Target.Font.Name
          .FontStyle = Target.Font.FontStyle
          .Size = Target.Font.Size
          .ColorIndex = Target.Font.ColorIndex
        End With
        trouve.Resize(1, 22).Interior.ColorIndex = Target.Interior.ColorIndex
      End If
    End With
  Next
Next
End Sub

Bonne nuit
 

Pièces jointes

Re : Transfert format d'un onglet source vers plus de 50 onglets...

Après essai, il existe une limite...

en effet, il n'est pas possible de modifier le format des cellules vides.

Aussi bien lors de la suppression d'une spécialitée où la modification de la couleur de fond (passage à aucune couleur), ne peux se faire qu'en 2 temps: 1- Suppression du format et 2-suppression du nom de la spécialité.

Je me penche sur le problème.

Ré-edit: le problème viens de la ligne:

Code:
      Set trouve = .Columns(2).Find([COLOR="Red"]Target.Value[/COLOR], LookIn:=xlValues, lookat:=xlWhole)

puisqu'on recherche en fonction de la valeur de la cellule et si elle est vide, j'imagine qu'on tombe de la cas ou le "with trouve" n'est pas traité...

Re-edit de 12h30...

Voici le code nikel qui se contente des coordonées des cellules d'arrivées (identique pour chaque onglet).

Code:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Intersect(Target, Range("C10")) Is Nothing Then Exit Sub

Dim j As Integer
 
 j = 4

For Each Target In Range("B11:B28")
  

    For i = 2 To Sheets.Count
        
        With Sheets(i)
          Set trouve = Sheets(i).Cells(j, 2) '2 n°de colonne, j n°de ligne
          If Not trouve Is Nothing Then
            With trouve.Resize(1, 22).Font
              .Name = Target.Font.Name
              .FontStyle = Target.Font.FontStyle
              .Size = Target.Font.Size
              .ColorIndex = Target.Font.ColorIndex
            End With
            trouve.Resize(1, 22).Interior.ColorIndex = Target.Interior.ColorIndex
          End If
        End With
        
    Next
    
  j = j + 1
  
Next
End Sub

Voilà en espérant que ça n'est pas servi qu'à moi.

Et Merci encore à Job75 et Skoobi!!!
 
Dernière modification par un modérateur:
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD
Assurez vous de marquer un message comme solution pour une meilleure transparence.
Retour