Code qui ne copie pas la mise en forme sur une autre feuille

Bonjour,

J'ai un code qui me permet avec l'aide d'un bouton copier une ligne sous condition mais j'aimerais que sa ne copie pas les mise en forme conditionnelle sur mon autre feuille car a chaque fois que je clique sur se bouton sur l'autre feuille j'ai toute les règles de la première, voici mon code :

Sub soudeusetraca()
Dim OS As Worksheet 'déclare la variable OS (Onglet Source)
Dim OD As Worksheet 'déclare la variable OD (Onglet Destination)
Dim TV As Variant 'déclare la variable TV (Tableau des valeurs)
Dim I As Integer 'déclare la variable I (Incrément)
Dim DEST As Range 'déclare la variable DEST (cellule de DESTination)

Set OS = Worksheets("Soudeuse") 'définit l'onglet source OS
Set OD = Worksheets("tracabilité") 'définit l'onglet destination OD
TV = OS.Range("A1").CurrentRegion 'définit le tableau des Valeurs TV
For I = 2 To UBound(TV) 'boucle sur toutes les lignes I du tableau de valeurs TV (en partant de la seconde)
    If TV(I, 15) = "ü" Then 'condition : si la donnée ligne I colonne 12 est égale à "ü"
        'définit la cellule de destination DEST (première cellule vide de la colonne A de l'onglet OD)
        Set DEST = OD.Cells(Application.Rows.Count, "A").End(xlUp).Offset(1, 0)
        OS.Cells(I, 1).Resize(1, 12).Copy DEST 'copie la cellule ligne I, colonne 1 redimensionnée dans DEST
        OS.Cells(I, 15).Value = "û" 'remplace la coche verte par la croix rouge
        OS.Cells(I, 5).Value = ""
        OS.Cells(I, 6).Value = ""
    End If 'fin de la condition
Next I 'prochaine ligne de la boucle
End Sub

et voici mes règles sur la feuille source :

Merci d'avance !

Salut Laurent,

il n'est pas toujours nécessaire d'utiliser COPY.
Essaye ceci :

DEST.Value = OS.Cells(I, 1).Resize(1, 12)

A+

@curulis57 Bonjour, j'ai essayer de remplacer ta ligne sur mon code mais du coup sa ne le met plus sur ma feuille destination si tu veux je peut te mettre le fichier ici pour que sa soit peut être plus explicite ?

Un fichier est TOUJOURS la règle à observer pour une aide efficace!
C'est vrai que l'adressage de DEST est bizarre...

@Curulis57 Voici donc mon fichier, c'est sur la macro "soudeusetraca", et pour réexpliquer mieux a chaque que je clique sur mon bouton sa copie bien la ligne que je veux sur ma feuille traçabilité mais sa copie aussi toutes mes mise en forme conditionnelle mais du coup a chaque fois que je fait cette manip sa créer des doublons dans les règles de ma feuille traçabilité .

Salut Laurent,

ton fichier quelque peu à ma sauce.

Quand tu as, comme ici, plusieurs feuilles identiques dans leur structure et leur mode de fonctionnement, tu as tout intérêt à coder dans le module 'ThisWorkbook'.
Le code de ce module est valable pour tout le classeur : un seul code peut être exécuté par des dizaines de feuilles !
On peut évidemment ajouter toutes les conditions et exceptions pour coïncider avec les particularités d'une feuille ou l'autre.

J'ai donc supprimé les boutons, remplacés dans leur rôle par la cellule "Validation" en orange.
Tu remarqueras que je ne déclare quasi aucune variable (je ne déclare jamais les variables de boucle), l'adressage pouvant être très souvent simplifié avec l'instruction "WITH".

Autres modifications :
- avec un impact important, la cellule "Validation" s'active via un double-clic ;
- les coches basculent sur un simple clic

Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
'
Cancel = True
'
Dim sWk As Worksheet, iRow%
'
If Not Intersect(Target, [O1]) Is Nothing Then
    Application.ScreenUpdating = False
    Set sWk = Worksheets(Sh.Name)
    '
    With Worksheets("Traçabilité")
        For I = 2 To sWk.Range("O" & Rows.Count).End(xlUp).Row
            If sWk.Range("O" & I).Value = "ü" Then _
                iRow = .Range("A" & Rows.Count).End(xlUp).Row + 1: _
                .Range("A" & iRow & ":L" & iRow).Value = sWk.Range("A" & I & ":L" & I).Value: _
                sWk.Cells(I, 15) = "û": _
                Union(sWk.Cells(I, 5), sWk.Cells(I, 6)) = ""
        Next
    End With
    '
    Application.ScreenUpdating = True
End If
'
End Sub

Je te laisse potasser tout ça...

A+

@curulis57 salut merci de ton aide mais a vrai dire je ne comprend pas trop le fichier, comme comprendre où trouver le code, comprendre comment validé une ligne pour quel se copie dans la feuille traçabilité peut tu me renseigner s'il te plait ?

@curulis57 Je te remercie encore beaucoup d'avoir pris ton temps pour m'aider mais a vrai dire c'est pas réellement se que j'attendais car mon script marchait très bien j'avais juste besoin d'éviter de faire des doublons dans les règles de la mise en forme conditionnelle de ma feuille "traçabilité".

Salut Laurent,

je comprends que tu sois un peu perdu!

- le code se trouve dans le module 'ThisWorkbook'.
Comme expliqué, tes feuilles 'Soudeuse' et 'Agitateur' ont exactement la même structure et le même mode de fonctionnement. Le module 'ThisWorkbook' permet justement d'y écrire un code unique pouvant être exécuté indifféremment sur ces feuilles identiques : gain de codage.
D'ailleurs, je me rends compte d'un oubli coupable : le ciblage des feuilles corrigé dans le fichier joint.

If Sh.Name <> "Traçabilité" Then

- sauf erreur monumentale, il effectue exactement ce que tu souhaites : les coches et la copie sans les MFC.

- Pour cocher et décocher les lignes à valider, il suffit d'un clic sur la cellule ad hoc en colonne [O:O];
- Pour copier les lignes dans 'Traçabilité', il faut un double-clic sur la cellule orange "Validation".

Justement, plus simple, c'est difficile !

A+

@curulis57 merci, pour savoir quel ligne du code ou permet de ne pas copier les règles de la feuille source ?

Salut Laurent,

- en mode d'adressage direct sans COPY

.Range("A" & iRow & ":L" & iRow).Value = sWk.Range("A" & I & ":L" & I).Value

- en chipotant avec COPY (sous commentaire dans le code ci-dessous)

 sWk.Range("A" & I & ":L" & I).Copy
 .Range("A" & iRow & ":L" & iRow).PasteSpecial (xlPasteValues)

C'est toi le patron, après tout...

        With Worksheets("Traçabilité")
            For I = 2 To sWk.Range("O" & Rows.Count).End(xlUp).Row
                If sWk.Range("O" & I).Value = "ü" Then
                    iRow = .Range("A" & Rows.Count).End(xlUp).Row + 1
                    '
                    '
                    'sWk.Range("A" & I & ":L" & I).Copy
                    '.Range("A" & iRow & ":L" & iRow).PasteSpecial (xlPasteValues)
                    '
                    '
                    .Range("A" & iRow & ":L" & iRow).Value = sWk.Range("A" & I & ":L" & I).Value
                    '
                    '
                    sWk.Cells(I, 15) = "û"
                    Union(sWk.Cells(I, 5), sWk.Cells(I, 6)) = ""
                End If
            Next
            .Activate
        End With

Ça va aller, tu verras...

A+