Microsoft 365 En fonction d'une condition, copier plusieurs cellules particulières d'un coup

PCharlier · 15 Décembre 2021

Bonjour à tous,
Je me tourne vers vous pour un besoin qui me ronge le cerveau depuis quelques heures!
Mon but est de copier coller une liste de produits d'un onglet COMMANDES et quelques attributs (quantité, numéro de commande, famille de produits), et de remplacer les lignes de commandes liées à des menus par le contenu de ce menu (cf feuille MENU)

Voici mon code pour l'instant, mais je n'arrive pas à la partie sur le contenu des menus :/ Peut etre que ce serait plus simple avec les fonctionnalités de tableau, mais je ne les maîtrise pas..
J'attache aussi le fichier avec un onglet "Target" où on voit ce que j'essaye de faire, avec en jaune ce que les menus devraient renvoyer.

VB:

Sub copier_coller()
Dim Nbrligne&, L&, L1&
Dim ws_menu As Worksheet
Dim ws_source As Worksheet
Dim ws_resultat As Worksheet
Set ws_menu = Worksheets(1)
Set ws_source = Worksheets(2)
Set ws_resultat = Worksheets(3)

ws_source.Select

Application.ScreenUpdating = False 'Désactive l'affichage en temps réel
Application.Calculation = xlCalculationManual 'Désactive le recalcul auto des formules Excel à chaque modification

With ws_source
    Nbrligne = .Range("A" & .Rows.Count).End(xlUp).Row 'Calcul le nombre de lignes en ws_source
    L1 = 2
    For L = 186 To Nbrligne
        If .Range("I" & L).Value Like "Menu*" Then
            ' ici je ne sais pas comment copier le contenu du menu (présent dans ws_menu) au lieu du nom
            'du menu, avec une ligne pour chaque produit du menu (donc 6 lignes copiée à chaque fois qu'un
            'menu tombe)
            'De même je dois réussir à faire revenir la quantité, le numéro de commande et la famille de
            'produit correspondant au menu
        Else
            Range("A" & L).Copy
            Range("A" & Range("A65536").End(xlUp).Row + 1).PasteSpecial (xlPasteValues)
            Range("B" & L).Copy
            Range("B" & Range("B65536").End(xlUp).Row + 1).PasteSpecial (xlPasteValues)
            Range("I" & L).Copy
            Range("C" & Range("C65536").End(xlUp).Row + 1).PasteSpecial (xlPasteValues)
            Range("J" & L).Copy
            Range("D" & Range("D65536").End(xlUp).Row + 1).PasteSpecial (xlPasteValues)
        End If
    Next
End With
Application.CutCopyMode = False
End Sub

Sauriez vous m'aider?

Merci beaucoup!!

fanfan38 · 16 Décembre 2021

Bonjour
Ci joint ma solution

A+ François

fanfan38 · 16 Décembre 2021

Bonjour
Ci joint ma solution

A+ François

PCharlier · 16 Décembre 2021

C'est parfait merci beaucoup!
Pour que je m'améliore, est ce que vous auriez le temps de m'expliquer brièvement la logique sur cette partie du code:

VB:

        If .Range("I" & L).Value Like "Menu*" Then
            menu = Mid(.Range("I" & L).Value, 7, Len(.Range("I" & L).Value) - 7)
            dc = ws_menu.Cells(2, Columns.Count).End(xlToLeft).Column
            ctrl = False
            For col = 2 To dc
              If ws_menu.Cells(2, col).Value Like "*" & menu & "*" Then ctrl = True: Exit For
            Next
            If ctrl = False Then rep = MsgBox("Menu inexistant", vbCritical, "Menu"): Exit Sub
            dlm = ws_menu.Cells(Rows.Count, col).End(xlUp).Row
            dlr = ws_resultat.Range("A" & Rows.Count).End(xlUp).Row + 1

Excellente journée à vous!

fanfan38 · 16 Décembre 2021

VB:

        If .Range("I" & L).Value Like "Menu*" Then
        'menu est une variable qui me dit quelle menu c'est
        menu = Mid(.Range("I" & L).Value, 7, Len(.Range("I" & L).Value) - 7)
        'on cherche la derniere colonne des menus
            dc = ws_menu.Cells(2, Columns.Count).End(xlToLeft).Column
            ctrl = False' variable pour savoir si il a trouvé le menu
            For col = 2 To dc 'boucle sur les colonnes des menu
             'si il trouve le menu il quitte la boucle (ce qui donne la colonne)
              If ws_menu.Cells(2, col).Value Like "*" & menu & "*" Then ctrl = True: Exit For
            Next
            'si il a pas trouvé le menu correspondant
            If ctrl = False Then rep = MsgBox("Menu inexistant", vbCritical, "Menu"): Exit Sub
            'derniere ligne du menu correspondant
            dlm = ws_menu.Cells(Rows.Count, col).End(xlUp).Row
            'derniere ligne +1 de la feuille resultat
            dlr = ws_resultat.Range("A" & Rows.Count).End(xlUp).Row + 1

PCharlier · 16 Décembre 2021

Merci beaucoup!

Microsoft 365 En fonction d'une condition, copier plusieurs cellules particulières d'un coup

PCharlier

XLDnaute Nouveau

Pièces jointes

fanfan38

fanfan38

XLDnaute Barbatruc

Pièces jointes

PCharlier

XLDnaute Nouveau

fanfan38

XLDnaute Barbatruc

PCharlier

XLDnaute Nouveau

Discussions similaires