Copie avec double clic et selection de ligne(s) suivant la valeur

Bonjour,

Cela fait quelques temps que je cherche à faire quelque chose sans y arriver. De plus je ne sais pas trop comment chercher les bonne infos étant toujours novice en VBA.

J'ai appris pleins de truc pendant mes recherches mais pas ce que je recherche réellement.

En gros j'aimerai me faciliter la vie en faisant mes devis et surtout ne rien oublier ! Dans pas mal de cas si je sélectionne un article dans ma base de donné, il faudrait que d'autres articles soient aussi automatiquement sélectionnés et aussi copié vers la feuille qui résume le tout.

Actuellement mon code me permet de copier une partie de la ligne en double cliquant sur la colonne "A".

Cela copie la partie de ligne désirée et colle l'info vers une autre feuille appelé " Devis ". Mais voila, si je sélectionne un article du kit "BLA" ( cette information se trouvant dans la colonne "A"), je voudrais que tout les autres articles "BLA" de la colonne "A" soient aussi copié et de la même manière vers la feuille "Devis". Comme cela rien n'est oublié.

Il va de soit que si il n'y a pas d'autres article similaire dans la colonne "A", la selection soit simplement copié et collé comme les autres.

Dans ma feuille "Devis" je peux aussi double-cliquer sur la ligne et cela me permet d'enlever rapidement les lignes qui ne sont pas nécessaires pour le devis.

Je ne sais pas trop si je dois partir sur du IF ou du CASE ... il y aura beaucoup de groupe de kits différents au file du temps.

En gros c'est un gros casse tête de pense bête !

Voici le code de la page qui contient les données à copier vers la feuille devis

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    Dim wks As Worksheet
    Dim lastrow As Integer
    Set wks = Worksheets("Devis")
    If wks.Range("A1").Value = "" Then
        lastrow = 1
    Else
        lastrow = wks.Range("A65536").End(xlUp).Row + 1
    End If

    If Not Intersect(Target, Range("a2:a10000")) Is Nothing Then

        A = Target.Row
        Range(Cells(A, 1), Cells(A, 4)).Copy
        wks.Activate
        wks.Range("A" & lastrow).Select
        ActiveSheet.Paste

    End If

    Sheets("BDD").Activate

End Sub

Et voice le code de la feuille devis

 
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Target.Cells.Count > 1 Then Exit Sub
Cancel = True
Rows(Target.Row).Delete
End Sub

Je vous remercie d'avance pour l'attention que vous y apporterez !

Et même si vous n'avez pas de solution à m'apporter

Salut,

Le code ci-joint devrait répondre à ton attente.

Tu peux cliquer sur n'importe quelle ligne d'un groupe à reporter.

Amicalement.

Bonjour,

Une autre proposition à étudier.

Les données sont sous forme de tableaux structurés (ListObject) et on utilise le filtre automatique pour la copie.

A te relire.

Cdlt.

Salut,

La première proposition fonctionne en partie. Les lignes avec une info similaire dans la colonne A sont copiés mais si dans le futur j'ajoutai des nouvelles lignes ou que je les mélanges pour filtrer l'information nécessaire alors la copie ne se fait plus correctement.

Mais la deuxième proposition fonctionne à merveille !!!

Il va de soit que je vais décortiquer cela et travailler à comprendre toutes ces lignes de code sur les "tableaux structurés (ListObject)" et " le filtre automatique" pour la copie.

J'ai vraiment pensé que j'allais devoir écrire toutes les conditions mais avec la deuxième solution le tableau peut évoluer sans que je doive intervenir.

En gros je vais pouvoir partir en vacance plus souvent !!!

Merci à vous deux pour avoir plancher sur mon problème !

Quand j'aurai terminé tout mon bazar je le mettrais sur le site.

Cracotte a écrit :

La première proposition fonctionne en partie. Les lignes avec une info similaire dans la colonne A sont copiés mais si dans le futur j'ajoutai des nouvelles lignes ....... alors la copie ne se fait plus correctement.

Je ne comprends pas trop bien ton affirmation. Tu peux ajouter autant de lignes que tu veux, mon code fonctionne encore. Ceci pour autant que tu ajoutes des groupes ‘’groupés’’, comme sur ton modèle !!

Si tu veux reporter des groupes séparés, il aurait fallu le préciser. Dans le fichier ci-joint, un code qui réalise ton nouveau souhait. Selon ce que je comprends de ton niveau en VBA, il sera peut-être plus à ta portée que celui de Jean-Eric qui est quand même de la haute voltige

Chaleureusement.

J'espère ne pas t'avoir offensé

Tu as raison que le code de eric est de la haute voltige ! J'ai l'impression que je vais y passer un petit temps avant de comprendre.

J'allais de toute façons bien regarder les deux solutions pour apprendre et comprendre les différences.

D'ailleurs si vous aviez le temps de me mettre des petites notes dans le code se serait vraiment génial pour que je ne prenne pas trop de temps à dechifrer le tout

Je ne suis vraiment pas habituer aux forums et c'est très compliqué de condenser une pensé en texte, ça fait vraiment beaucoup de lignes de code !

Merci

Bonjour,

Depuis Excel 2007, il est préconisé d'utiliser les tableaux structurés (dynamiques) pour gérer les données.

Ma proposition n'est que bon sens : Elle utilise le filtre automatique pour copier les données en bloc !...

Elle ne fait que ce l'on ferait manuellement.

Je peux te faire la même chose, pour une plage de cellules avec le même principe, si l'utilisation de tableaux structurés te gêne.

Je renvoie tout de même le fichier avec la procédure commentée.

A te relire.

Cdlt.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
'Déclaration des variables
Dim lo As ListObject, lo2 As ListObject, Rng As Range, rCell As Range
    'Si le double-clic n'est pas effectué dans le tableau T_BDD
    'de la feuille BDD (feuille active), on quitte la procédure
    If Target.ListObject Is Nothing Then Exit Sub
    'Initialisation du tableau T_BDD de la feuille BDD (feuille active)
    Set lo = Target.ListObject
    'Si le double-clic est effectué en colonne 1 du tableau T_BDD
    If Not Intersect(Target, lo.ListColumns(1).DataBodyRange) Is Nothing Then
        Cancel = True
        With lo 'T_BDD
            'Si le filtre automatique est affiché, on affiche tout
            If .ShowAutoFilter Then lo.AutoFilter.ShowAllData
            'On filtre le tableau sur la valeur de la cellule du double-clic (Target)
            .Range.AutoFilter field:=1, Criteria1:=Target.Value
            'Initialisation de la plage filtrée
            Set Rng = .AutoFilter.Range
        End With
        'Initialisation du tableau T_Devis de la feuille Devis
        Set lo2 = Worksheets("Devis").ListObjects(1)    'ou Listobjects("T_Devis")
        'On determine la cellule de destination pour la copie des données filtrées
        With lo2    'T_Devis
            If .InsertRowRange Is Nothing Then
                'Si le tableau comporte des données (dernière ligne non vide +1)
                Set rCell = .HeaderRowRange.Cells(1).Offset(.ListRows.Count + 1)
            Else
                'Si le tableau est vide (1ère. ligne)
                Set rCell = .InsertRowRange.Cells(1)
            End If
        End With
        Application.ScreenUpdating = False
        'On copie la plage filtrée de T_BDD sans les en-têtes
        Rng.Offset(1).Resize(Rng.Rows.Count - 1, Rng.Columns.Count - 1) _
                .SpecialCells(xlCellTypeVisible).Copy
        'Restitution des données copiées dans T_Devis de la feuille Devis
        rCell.PasteSpecial xlPasteValues
        Application.CutCopyMode = False
        'On ajuste la largeur des colonnes T_Devis
        lo2.HeaderRowRange.EntireColumn.AutoFit
        'RAZ filtre T_BDD
        lo.Range.AutoFilter field:=1
    End If
End Sub

Super cool ! MERCI

Je planche la dessus ce soir, après les obligations.