Cases a cocher puis copier / coller dans une autre feuille

[lcoulon]

Bonjour,

Je cherche a realiser une macro ou une formule qui me permettrai de selectionner des cellules ( colonne A de feuil 1 ) grace a des cases à cocher ( colonne B de feuil 1 ) et de copier le contenu des cellules alors selectionnées sur feuil2 ( afin de pouvoir imprimer plus tard )

Je vous remercie beaucoup de votre aide,

 

[skoobi]

Re : Cases a cocher puis copier / coller dans une autre feuille

Bonjour,

voici un exemple à adapter.

 

[lcoulon]

Re : Cases a cocher puis copier / coller dans une autre feuille

Merci beaucoup pour ta macro, cela va deja bien m'aider.

Puis je te demander ce qu'il faudrait modifier dans la macro pour pouvoir effectuer le collé de chaque cellule selectionné à un endroit précis.

Je m'explique, par exemple pouvoir indiquer a la macro que dans feuille1 a est coché alors il copie/colle a dans feuille2 dans la cellule A2.

pour z, le copier / collé ira en feuille2 dans la cellule B2 en police couleur bleu
pour e, le copier / collé ira en feuille2 dans la cellule A6 en police couleur vert
pour r, le copier / collé ira en feuille2 dans la cellule C6 en rouge couleur noir

Ci joint ton petit fichier reprenant l'idee.

Merci encore pour ton aide,

 

[lcoulon]

Re : Cases a cocher puis copier / coller dans une autre feuille

exemple de présentation telle que je l'aimerai bien ...

fichier ci-joint.

 

[skoobi]

Re : Cases a cocher puis copier / coller dans une autre feuille

Re,

voici la macro modifiée:

Sub copie()
Sheets(2).Range("A2").ClearContents
Sheets(2).Range("B2").ClearContents
Sheets(2).Range("A6").ClearContents
Sheets(2).Range("C6").ClearContents
cpte = 0
For Each coche In Sheets(1).Shapes
cpte = cpte + 1
    If coche.Name Like "Check*" Then
        If coche.ControlFormat.Value = 1 Then
            Select Case cpte
            Case 1: Sheets(2).Range("A2") = Range("A" & coche.TopLeftCell.Row)
            Case 2: Sheets(2).Range("B2") = Range("A" & coche.TopLeftCell.Row)
            Case 3: Sheets(2).Range("A6") = Range("A" & coche.TopLeftCell.Row)
            Case 4: Sheets(2).Range("C6") = Range("A" & coche.TopLeftCell.Row)
            End Select
        End If
    End If
Next
Sheets(2).Select
End Sub

 

[lcoulon]

Re : Cases a cocher puis copier / coller dans une autre feuille

Merci skoobi

J'ai quand meme quelquechose qui m'echappe :

lorsque j'essaie d'ajouter d'autres cases a cocher , les copies ne se font pas.

Y a t-il une macro avec les cases a cocher que je n'aurais pas vu ?
les cases a cocher sont allusion a la macro "Caseàcocherx_QuandClic"

mais je n'arrive pas la a visualiser ( désolé je suis débutant )

 

[skoobi]

Re : Cases a cocher puis copier / coller dans une autre feuille

Re,

le premier code que je t'ai donné prends en compte "x" case à cocher.
Le deuxième n'en prends que 4 en comptes car:
Case1:......
Case2:......
Case3:......
Case4:......

Si tu veux ajouter d'autre coche, il faudra changer de stratégie mais pour celà il faudra que tu me donnes la "séquence" des cellules de destination.

Range("A2")
Range("B2")
Range("A6")
Range("C6")
Range("??")
Range("??")

Y a-t-il une logique?

 

[lcoulon]

Re : Cases a cocher puis copier / coller dans une autre feuille

En fait, je veux effectivement avoir la possibilité de cocher x cases, et pouvoir choisir a chaque fois sa destination de collage.

( même si la macro doit être longue )

Par contre comment as tu fait pour créer tes cases a cocher, est ce a chaque fois depuis la " Boite a Outils Controle " puis Creation ?

Je te remercie,

 

[skoobi]

Re : Cases a cocher puis copier / coller dans une autre feuille

Par contre comment as tu fait pour créer tes cases a cocher, est ce a chaque fois depuis la " Boite a Outils Controle " puis Creation ?

Non, depuis la boite à outils "Formulaires".

 

[lcoulon]

Re : Cases a cocher puis copier / coller dans une autre feuille

Merci, moi j'utilisais une mauvaise case à cocher , celle de la boite à outils " Contrôles " ...

Pour en revenir au 1er exemple que tu m'as envoyé,

A1 de feuil1 est collé sur A1 de feuil2 si la case correspondante est cochée.
mais, comment peut on faire pour collé en A2 de feuil2, la cellule A4 de feuil1 si par exemple A2 et A3 ne sont pas cochés ?

en fait, il s'agit sur la feuille de destination de ne pas sauter de lignes et de mettre a la suite les collages selectionnés .


Pas évident d'être très clair ...

 

[skoobi]

Re : Cases a cocher puis copier / coller dans une autre feuille

Re bonjour,

en fait, il s'agit sur la feuille de destination de ne pas sauter de lignes et de mettre a la suite les collages selectionnés .

voici la macro du fichier que je t'ai envoyé la première fois modifiée (en bleu les modifications permettant de "mettre à la suite"):

Sub copie()
Sheets(2).Cells.Clear
For Each coche In ActiveSheet.Shapes
    If coche.Name Like "Check*" Then
        If coche.ControlFormat.Value = 1 Then
[COLOR=Blue][B]            lig = Sheets(2).Range("A65536").End(xlUp).Row + 1[/B][/COLOR]
            Range("A" & coche.TopLeftCell.Row).Copy Sheets(2).Range("A" & [COLOR=Blue][B]lig[/B])[/COLOR]
        End If
    End If
Next
Sheets(2).Select
End Sub

A noter que la première ligne sera toujours vide.

 

[skoobi]

Re : Cases a cocher puis copier / coller dans une autre feuille

Merci quand meme.

Puis je te demander une derniere chose :

Est il possible , lorsqu'une case est cochée que le contenu de non pas 1 mais 2 cellules ayant ayant chacune des données indissociables soient collées vers une autre feuille ?

par exemple :

Colonne A Colonne B Case a cocher

AZCV ZERR x
RETT OIUU
FDFF HFFF x

AZCV et ZERR sont collés en feuill2 A1 et B1
FDFF et HFFF sont collés en feuill2 A2 et B2

Merci de ton aide,

Re bonjour,

en bleu ce qu'il faut ajouter:

[/COLOR]
[COLOR=black]Sub copie()
Sheets(2).Cells.Clear
For Each coche In ActiveSheet.Shapes
    If coche.Name Like "Check*" Then
        If coche.ControlFormat.Value = 1 Then
            lig = Sheets(2).Range("A65536").End(xlUp).Row + 1
            Range("A" & coche.TopLeftCell.Row).Copy Sheets(2).Range("A" & lig)
            [/COLOR][B][COLOR=blue][FONT=Verdana]Range("B" & coche.TopLeftCell.Row).Copy Sheets(2).Range("B" & lig)[/FONT][/COLOR][/B][COLOR=black]
        End If
    End If
Next
Sheets(2).Select
End Sub

 

[Nicolas Duffour]

Bonjour,
Cette macro est ce que je cherche mais je suis incapable de de la transposer... Quelqu'un pourrait m'y aider ???
Merci