XL 2019 Copier coller une case à cocher avec cellules liées.

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 !

Twixman

XLDnaute Nouveau
Bonjour,

Voici mon problème:

J'ai une case à cocher en B3 avec la cellule liée C3 et j'aimerais la copier en B4:B100 tout en gardant les cellules à côté liées (B4->C4, B5->C5, .......), puis copier B3:B100 et coller en D3😀100.

Et ainsi de suite.

Tout cela pour créer une énorme liste avec différents choix.

Quelqu'un aurait-il la solution?

Merci.
 
Bonjour Twixman,

Si la Case à cocher en B3 est bien un contrôle de formulaire avec cellule liée en C3 exécutez cette macro :
VB:
Sub CopierObjet()
Dim o As Object, MaCase As Object, x#, y#, c As Range
Application.ScreenUpdating = False
With ActiveSheet 'à adapter éventuellement
    '---RAZ---
    For Each o In ActiveSheet.DrawingObjects
        If TypeName(o) = "CheckBox" Then If Replace(o.LinkedCell, "$", "") = "C3" Then Set MaCase = o Else o.Delete
    Next o
    '---duplication---
    .[C3] = False 'True
    x = MaCase.Left - .[B3].Left
    y = MaCase.Top - .[B3].Top
    For Each c In .[B4:B100,D3:D100]
        With MaCase.Duplicate
            .Left = c.Left + x
            .Top = c.Top + y
            .LinkedCell = c(1, 2).Address
            c(1, 2) = False 'True
        End With
    Next c
End With
End Sub
A+
 
S'il s'agit d'un contrôle ActiveX la copie se fera avec cette macro :
VB:
Sub CopierObjet()
Dim o As Object, MaCase As Object, x#, y#, c As Range
Application.ScreenUpdating = False
With ActiveSheet 'à adapter éventuellement
    '---RAZ---
    For Each o In ActiveSheet.OLEObjects
        If TypeName(o.Object) = "CheckBox" Then If Replace(o.LinkedCell, "$", "") = "C3" Then Set MaCase = o Else o.Delete
    Next o
    '---duplication---
    .[C3] = False 'True
    x = MaCase.Left - .[B3].Left
    y = MaCase.Top - .[B3].Top
    For Each c In .[B4:B100,D3:D100]
        With MaCase.Duplicate
            .Left = c.Left + x
            .Top = c.Top + y
            .LinkedCell = c(1, 2).Address
            c(1, 2) = False 'True
        End With
    Next c
End With
End Sub
Chez moi l'exécution prend beaucoup plus de temps.
 
- 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

Discussions similaires

Réponses
5
Affichages
175
Réponses
5
Affichages
472
Retour