Copier lignes selon sélection dans menu déroulant

Bonjour,

Je me tourne vers vous aujourd’hui parce que je comprend pas comment résoudre mon problème :neutral_face:

Je vous met mon fichier :

Essai.xlsx (189,0 Ko)

Ce que je souhaite faire c’est sélectionner toutes les valeurs que je veux dans la feuille “Mozilla”
Puis cliquer sur un bouton pour copier les lignes associées de la feuille “Data” colonne G, dans la feuille “Chaque jour”.
J’aimerais que ces valeurs soient copier les une en dessous des autres.

Et si c’est trop compliqué, j’avais pensais simplement remplir une case sur la première feuille, et ça viendrait copier les valeurs associés de la feuille “Data” selon le critère dans la colonne G, à la suite dans la feuille “Chaque jour”

Je vous remercie par avance pour votre aide :slightly_smiling_face:

Bonjour,

Pas très facile la question, néanmoins, cela devrait fonctionner
J’ai changer le type de LISTBOX, avec ton exemple, pas pratique pour la sélection.

Module:

Option Explicit
Sub test()
Dim maliste As New Collection
Dim maliste2 As New Collection
Dim i, j%, Dl%, Dl2%
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Feuil3.Cells.CurrentRegion = "" 'efface les données feuil3
For i = 0 To Feuil11.ListBox1.ListCount - 1 'boucle sur feuil11 sur les item cochés
    If Feuil11.ListBox1.Selected(i) = True Then
    maliste.Add (Feuil11.ListBox1.List(i)) 'place en mémoire les items
    maliste2.Add (i) 'place en mémoire les emplacements des items
    End If
Next
j = 2
For Each i In maliste 'boucle pour afficher les items de la liste et les place en feuil3 col8
    Feuil3.Cells(j, 8) = i
    j = j + 1
Next
j = 2
For Each i In maliste2 'boucle pour afficher les N° items de la liste et les place en feuil3 col1
    Feuil3.Cells(j, 1) = i + 2
    j = j + 1
Next 'Entête colonne
    Feuil3.Cells(1, 1) = "Noligne"
    Feuil3.Cells(1, 8) = "Recette"
    Feuil3.Cells(1, 7) = "Ligne"
    Feuil3.Cells(1, 6) = "VP prio"
    Feuil3.Cells(1, 5) = "PXRTRI"
    Feuil3.Cells(1, 4) = "PXRCMP"
    Feuil3.Cells(1, 3) = "PXRVL"
    Feuil3.Cells(1, 2) = "PXRART"
    
Dl = Feuil3.Range("A" & Rows.Count).End(xlUp).Row 'n° de la dernière ligne non vide de la colonne A feuil3
Dl2 = Feuil1.Range("A" & Rows.Count).End(xlUp).Row 'n° de la dernière ligne non vide de la colonne A feuil1
For i = 2 To Dl 'boucle sur les N°de ligne de la feuil3 et récupère les données de la feuil2
  j = Feuil3.Cells(i, 1).Value 'valeur du N° de la ligne de l'item en feuil3
  Feuil3.Cells(i, 2).Value = Feuil2.Cells(j, 1)
  Feuil3.Cells(i, 3).Value = Feuil2.Cells(j, 2)
  Feuil3.Cells(i, 7).Value = Feuil2.Cells(j, 4)
Next i
 i = 2
  For j = 2 To Dl2 'boucle sur la concaténation de la feuil3 et récupère les données de la feuil2
    If Feuil3.Cells(i, 2).Value & Feuil3.Cells(i, 3).Value & Feuil3.Cells(i, 7).Value & Feuil3.Cells(i, 8).Value = _
        Feuil1.Cells(j, 1).Value & Feuil1.Cells(j, 2).Value & Feuil1.Cells(j, 6).Value & Feuil1.Cells(j, 7).Value Then
      Feuil3.Cells(i, 4).Value = Feuil1.Cells(j, 3)
      Feuil3.Cells(i, 5).Value = Feuil1.Cells(j, 4)
      Feuil3.Cells(i, 6).Value = Feuil1.Cells(j, 5)
      i = i + 1
    End If
  Next j
Feuil3.Activate
Columns("A:A").Select 'supprime la colA (N° de ligne item)
Selection.Delete Shift:=xlToLeft
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Range("A1").Select
End Sub

le Classeur:
Essai (4)test.xlsm (204,5 Ko)