XL 2019 Check Boxes copie / coller

[frederio]

Bonjour à tous
Tu vous connais comment faire ?
Si tu veux être d’accord avec moi ??? vous m’aidez a expliqué comme Excel Merci


Sur la 1ère feuille "check boxes"

Toucher Check Boxes couleur orange

Sur la 2ère feuille "Check Boxes copie&coller"

comment faire un copier-coller automatique

 

[job75]

Bonjour frederio,

La macro dans le code de la 2ème feuille :

Private Sub Worksheet_Activate()
Dim lig&, r As Range
lig = 3
Application.ScreenUpdating = False
Rows(lig & ":" & Rows.Count).ClearContents 'RAZ
For Each r In Sheets("check boxes").[E4:T86].Rows
    If r.Cells(1, -2) = True Then
        Cells(lig, 3).Resize(, 16) = r.Value
        Cells(lig, 3) = lig - 2
        lig = lig + 1
    End If
Next
End Sub

Elle se déclenche quand on active la feuille.

A+

 

[mapomme]

Bonjour à tous,

@frederio ,

Tous vos messages sont pénibles à lire. Pourquoi employez-vous une police avec "mise en gras" (bold en anglais) ?
Une police en gras ne sert qu'à faire ressortir un mot ou deux qui sont importants à remarquer pour le lecteur. Mettre tout le texte en gras est dénué de (bon) sens.

A plus .

 

[frederio]

Sur la 1ère feuille "check boxes"

Couleur vert

Sur la 2ère feuille "Check Boxes copie&coller"

Comment faire un copier-coller vert

 

[laurent950]

Bonsoir,

Rows(lig & ":" & Rows.Count).ClearContents 'RAZ
Comment faire un copier-coller vert
Cells(lig, 3).Resize(, 16) = r.Value
r.Copy destination:=Range(Cells(lig, 3), Cells(lig, 3)).Resize(, 16)

 

[frederio]

désole j ai compris rien

 

[frederio]

j ai trouve merci

 

[job75]

Pour la couleur verte il n'y a que 3 cellules à copier sur chaque ligne :

Private Sub Worksheet_Activate()
Dim lig&, r As Range
lig = 3
Application.ScreenUpdating = False
Rows(lig & ":" & Rows.Count).Delete 'RAZ
For Each r In Sheets("check boxes").[E4:T86].Rows
    If r.Cells(1, -2) = True Then
        r.Cells(8).Resize(, 3).Copy Cells(lig, 10) 'pour copier les formats des 3 cellules
        Cells(lig, 10).Resize(, 3).Borders.LineStyle = xlNone 'supprime les bordures
        Cells(lig, 3).Resize(, 16) = r.Value 'copie les valeurs
        Cells(lig, 3) = lig - 2
        lig = lig + 1
    End If
Next
End Sub

 

[frederio]

merci beaucoup job75