Copier les lignes cochées d'un tableau

Yop le forum

Je travaille actuellement sur un tableau excel contenant des données. L'utilisateur "coche" (inscrit "x" dans la cellule Y de la ligne qu'il souhaite copier) une ou plusieurs lignes (pas de logique dans le cochage, c'est chacun choisit comme il veut :/), puis en cliquant sur un bouton, toutes les lignes cochées se copient dans la Feuil2 qui contient un tableau vierge au même format.

(Afin de pouvoir faire cette manip plusieurs fois de suite, j'ai mis une tite macro dans la Feuil2 (si la cellule avant Ligne_Finale se remplit, une ligne s'insère automatiquement)).

Le souci c'est que (bien évidemment), la macro de copie ne fonctionne pas...

Sub Copie1()

For Var_AB = 6 To 65536

If Range("YVar_AB") = x Then
Range("AVar_AB:XVar_AB").Select
Selection.Copy
Sheets("Feuil2").Select
Range("Ligne_Finale").Offset(-1,0).Select
ActiveSheet.Paste

End If

Next

End Sub

Je n'arrive pas à définir mon objet Range avec la variable dans le nom de la cellule .

Qui plus est, j'avoue que s'il existe une solution en évènementiel avec si x (ou case cochée) la ligne se copie, et si on décoche elle s'enlève de la Feuil2, je suis preneur, mais c'est bien au delà de mon niveau tout ça

Je vous joins mon fichier, n'hésitez pas à m'orienter sur des tutos ou des sujets similaires (bien que je n'en ai pas trouvé ), même si mon but final est que le fichier fonctionne, je veux avant tout apprendre comment faire

Merci d'avance et bonne journée

Bonjour à tous,

Avec filtre élaboré

Sub ExtraitX()
Dim Lg%
'Macro par Claude Dubois pour "SL2118" Excel-Pratique le 19 août 2010
    Lg = Cells.Find("*", , , , xlByRows, xlPrevious).Row
        Range("ab2") = "=y2=""x"""
    With Sheets("Feuil2")
        Range("a1:y" & Lg).AdvancedFilter Action:=xlFilterCopy, CriteriaRange:= _
        Range("ab1:ab2"), CopyToRange:=.Range("a1:x1"), Unique:=False
        Range("ab2").ClearContents
        .Activate
    End With
End Sub

Amicalement

Claude

Bonjour,

si x (ou case cochée) la ligne se copie, et si on décoche elle s'enlève de la Feuil2,

Vu que X n'est pas reporté sur la feuile 2, il faudrait savoir en fonction de quoi. Un fichier avec des données serait plus facile.

COmme j'avais avancé un peu sur ta demande, vois le fichier joint qui tient compte aussi de la macro que tu as placée dans la feuille 1. Le nom "Ligne finale" ne sert plus.

Amicalement

Re

Tout d'abord merci pour vos réponses rapides

J'ai testé les deux solutions et celle de Dan est celle qui convient le mieux, j'ai bien réussi à l'adapter dans le fichier original elle marche du tonnerre ^^

Finalement j'ai laissé tomber l'histoire de décocher suite à entretien avec mon boss, vu que cette macro sera utilisée par pas mal de monde (qui n'est pas forcément au même endroit que nous) il préfère garder la simplicité

Juste une dernière chose: comment faire pour que la hauteur de ligne se conserve lors du collage? Si pas possible pas grave ils feront ça à la main, c'est déjà génial ce système

Merci encore!!!!

Re,

Juste une dernière chose: comment faire pour que la hauteur de ligne se conserve lors du collage?

Remplace le code dans le module VBA par celui ci-dessous :

Sub Copie1()
'Dan le 19/08/10
Dim Var_AB As Integer, dlg As Integer
Dim hlg
For Var_AB = 2 To Range("Y65536").End(xlUp).Row
If UCase(Range("Y" & Var_AB)) = "X" Then
ok = True
hlg = Range("A" & Var_AB & ":Y" & Var_AB).Height
With Sheets("Feuil2")
dlg = .Range("A65536").End(xlUp).Row + 1
Range("A" & Var_AB & ":Y" & Var_AB).Copy .Range("A" & dlg)
    .Rows(dlg).RowHeight = hlg
End With
End If
Next
ok = False
End Sub

N'oublie pas de cloturer le fil.

Amicalement

Yop

La nouvelle macro insère bien la bonne hauteur mais si on sélectionne plusieurs lignes ça ne fonctionne pas... alors qu'avant ça fonctionnait ^^

Une idée?

Merci encore du temps passé pour m'aider

re,

si on sélectionne plusieurs lignes ça ne fonctionne pas...

Pas compris là . Le code fonctionne si tu cliques sur le bouton "copier les données"

Qu'est ce que tu fais exactement ?

Re

Dan a écrit :

Qu'est ce que tu fais exactement ?

Je coche "x" sur plusieurs lignes et je clique sur ledit bouton et ça ne copie qu'une seule ligne...

Voici la macro qui fonctionnait (sans la hauteur) adaptée dans mon fichier:

Public ok As Boolean
Sub CopiePA()

Dim Var_PA As Integer
For Var_PA = 2 To Range("Y65536").End(xlUp).Row
If UCase(Range("Y" & Var_PA)) = "X" Then
ok = True
Range("A" & Var_PA & ":Y" & Var_PA).Copy _
    Sheets("Plan d'Actions").Range("A" & Sheets("Plan d'Actions").Range("A65536").End(xlUp).Row + 1)

Sheets("Plan d'Actions").Range("Y6:Y65536").ClearContents
Range("Y6:Y65536").ClearContents

End If
Next
ok = False
End Sub

Et la dernière que tu m'as passée (celle qui ne copie qu'une seule ligne avec la hauteur) adpatée aussi dans mon fichier.

Public ok As Boolean
Sub CopiePA2()

    Dim Var_AB As Integer, dlg As Integer
    Dim hlg
    For Var_AB = 2 To Range("Y65536").End(xlUp).Row
    If UCase(Range("Y" & Var_AB)) = "X" Then
    ok = True
    hlg = Range("A" & Var_AB & ":Y" & Var_AB).Height
    With Sheets("Plan d'Actions")
    dlg = .Range("A65536").End(xlUp).Row + 1
    Range("A" & Var_AB & ":Y" & Var_AB).Copy .Range("A" & dlg)
        .Rows(dlg).RowHeight = hlg
    End With

    Sheets("Plan d'Actions").Range("Y6:Y65536").ClearContents
    Range("Y6:Y65536").ClearContents

    End If
    Next
    ok = False

End Sub

Ai-je fait une bêtise en l'adaptant?

Ou est-ce le rajout des ClearContents? Dans la première ça ne gênait pas et je les ai mis au même endroit

Sinon c'est vraiment le même système et la macro ne renvoie pas d'erreur, elle ne fait que copier une seule ligne au lieu de toutes celles "cochées".

J'espère être suffisamment clair :/ J'ai du mal à m'expliquer parfois

Merci

Bonjour,

à mon avis le

    Sheets("Plan d'Actions").Range("Y6:Y65536").ClearContents
    Range("Y6:Y65536").ClearContents

est à placer en dehors de la boucle (après le Next)

Claude

re,

Ben évidemment, là tu effaces à chaque passage de boucle et au final tu n'as plus que la dernière ligne dans ta feuille 2.

Comme Claude te le précises, tes deux instructions doivent être placées après le NEXT.

Amicalement

Re

En effet vous avez parfaitement raison ça fonctionne nickel en l'enlevant de la boucle...

Bizarre avant ça fonctionnait alors qu'il était dedans...

Enfin bref ^^ J'ai quand même été bien stupide pour le coup

Merci beaucoup à vous vous êtes vraiment géniaux!!!!

Amicalement et avec tous mes remerciements