Dupliquer une macros sur plusieurs lignes distinctes

Bonjour,

Bonne et Heureuse Année à vous et à vos proches,

Je viens de découvrir les macros et VBA pour la création de mon fichier. Ce fichier est un formulaire avec des boutons oui, non ou N/A pour chaque sous-questions

. A l'activation d'un bouton, la cellule doit changer de couleur et afficher un chiffre dans une colonne de la ligne (fichier ci-joint). J'ai environs 160 lignes et multiplier par 5 feuilles. Je voudrai copier/coller les boutons et les macros associé mais je n'y arrive pas. Par exemple la macros que j'ai créé pour le bouton non est :

Sub ouibis()
'
' ouibis Macro
'

'
Range("G7, I7").Select
Range("I7").Activate
With Selection.Interior
.Pattern = xlNone
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Range("H7").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 5296274
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Range("J7").Select
ActiveCell.FormulaR1C1 = "2"
Range("J7").Select
End Sub

En plus, j'ai des questions divisés en plusieurs sous-questions (nombre variables en fonction des questions). Je voudrai que mes boutons de ma question se remplissent automatiquement en fonction des réponses des sous-questions associées. Si tout N/A alors N/A. SI tout oui alors oui, si au moins 1 non alors non. J'ai du mal à voir comment mis prendre pour faire ça.

J'espère avoir été clair.

Merci d'avance d'avoir lu ce message jusqu'au bout et encore merci si pouvez m'aider

Bonne soirée

CC26

Salut CC26,

Pas trop chercher à comprendre tes formules pour l'instant mais, pour éviter une profusion de contrôles à gérer, je te propose ceci.
J'ai configuré les colonnes-réponses [G:H:I] en fonte Wingding 2, taille 18, GRAS, rouge pour NON, vert pour OUI et gris pour N/A.

Un simple clic détermine l'affichage d'un symbole et le compte des points en [J:J].
Le code, unique, se trouve dans le module VBA de 'Thisworkbook. Si la structure de tes autres onglets est parfaitement identique, il fonctionnera pour tous à condition que le formatage des colonnes-réponses soit réalisé de la même façon

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
'
If Not Intersect(Target, Columns("G:I")) Is Nothing Then _
    If Target.Font.Name = "Wingdings 2" Then _
        iRow = Target.Row: _
        iCol = Target.Column - 6: _
        Sh.Range("G" & iRow).Resize(1, 3).Value = "": _
        Target = Choose(iCol, "O", "P", "X"): _
        Sh.Range("J" & iRow).Value = Choose(iCol, 1, 2, 3): _
'
End Sub

Tu regardes si ça te convient et, éventuellement, comment l'améliorer.

Bonne année !

A+

Merci beaucoup je vais essayer