Microsoft 365 Création d'un panier sur valeur supérieur à 0

Gettos

XLDnaute Nouveau
Bonjour à tous,

J'ai créée un catalogue de fourniture de matériels électriques qui pour but d'aider mes collègues à générer leurs demandes d'offres de prix pour les transmettre à nos fournisseurs.
J'ai donc créée plusieurs feuilles qui sont classées par catégories de matériels. Sur ces pages, j'ai mis un bouton pour agrémenter le nombre d'articles souhaiter.
Un autre boutons en haut de la feuille et c'est celui qui me pose problème. Il aura pour but de sélectionner les lignes d'articles et de les envoyer dans la feuille "panier".
J'aimerai que par la même occasion, les cellules "quantité" soient remises à 0 à l'envoi dans la feuilles "panier". Histoire d'éviter qu'à la prochaine utilisation les cellules précédemment modifiées soient recopiées par erreur.
De la même façon que tous les sites marchands sur internet.
Je vous ai mis un extrait du catalogue en PJ.
Je souhaiterais savoir si quelqu'un a une idée sur le code que je pourrais installer sur ce bouton ?
Ps : Je suis débutant sur le codage.

Merci d'avance pour votre aide.
 

Pièces jointes

  • Exemple Catalogue références électricité tests Excel.xlsm
    77 KB · Affichages: 15

job75

XLDnaute Barbatruc
Bonjour Gettos, bienvenue sur XLD,

Voyez le fichier joint et cette macro :
VB:
Sub Panier()
Dim F1 As Worksheet, F2 As Worksheet, s As Shape, lig&, i&
Set F1 = Sheets("Consommables")
Set F2 = Sheets("Panier")
Application.ScreenUpdating = False
For Each s In F1.Shapes
    s.Placement = 1 'déplacer et dimensionner avec les cellules
Next
For Each s In F2.Shapes
    If s.TopLeftCell.Row > 3 Then s.Delete 'supprime les images et compteurs
Next
F2.Rows("4:" & F2.Rows.Count).Delete 'RAZ
lig = 4
With F1.[A1].CurrentRegion
    For i = 3 To .Rows.Count
        If .Cells(i, 9) > 0 Then
            .Rows(i).EntireRow.Copy F2.Cells(lig, 1)
            .Cells(i, 9) = 0 'RAZ
            lig = lig + 1
        End If
    Next
End With
F2.[A3].Copy [A3] 'allège la mémoire
If lig > 4 Then F2.Activate
End Sub
A+
 

Pièces jointes

  • Exemple Catalogue références électricité tests Excel(1).xlsm
    46.2 KB · Affichages: 4

job75

XLDnaute Barbatruc
S'il y a plusieurs feuilles à copier il suffit de faire une boucle, fichier (2) :
VB:
Sub Panier()
Dim F2 As Worksheet, s As Shape, lig&, F1 As Worksheet, i&
Set F2 = Sheets("Panier")
Application.ScreenUpdating = False
For Each s In F2.Shapes
    If s.TopLeftCell.Row > 3 Then s.Delete 'supprime les images et compteurs
Next s
F2.Rows("4:" & F2.Rows.Count).Delete 'RAZ
lig = 4
For Each F1 In Worksheets
    If F1.Name <> F2.Name Then
        For Each s In F1.Shapes
            s.Placement = 1 'déplacer et dimensionner avec les cellules
        Next s
        With F1.[A1].CurrentRegion
            For i = 3 To .Rows.Count
                If .Cells(i, 9) > 0 Then
                    .Rows(i).EntireRow.Copy F2.Cells(lig, 1)
                    .Cells(i, 9) = 0 'RAZ
                    lig = lig + 1
                End If
            Next i
        End With
    End If
Next F1
F2.[A3].Copy [A3] 'allège la mémoire
If lig > 4 Then F2.Activate
End Sub
 

Pièces jointes

  • Exemple Catalogue références électricité tests Excel(2).xlsm
    55.7 KB · Affichages: 4

Statistiques des forums

Discussions
292 746
Messages
1 925 834
Membres
182 846
dernier inscrit
elpatron-06