Bon de commande automatique

Bonjour à tous,

J'ai repris un fichier d'un ancien collègue (parti depuis de la société) et j'ai apporté quelques modifications.

Seulement je bloque sur certains point de son codage de la macro. seriez vous m'aider?

je joint un fichier. dans la feuille Produits, j'ai donc toute les gammes de produits existants, (au total 8, mais dans le fichier et un exemple), lors de la prise de commande, on complète cette feuille avec les quantités et ensuite on crée un bon de commande en cliquant sur ajouter et dans la feuille 'bon de commande' se crée normalement la même liste mais seulement avec les quantités plus grandes que 0, sauf que ca fonctionne pas...

Merci d'avance,

Benjamin

Bonjour

Essayez comme ceci :

Sub Panier()
Dim plageProd As Range, cell As Range
Application.ScreenUpdating = False
With Sheets("Bon de commande")
    .Range("A9:H" & .Range("A" & .Rows.Count).End(xlUp).Row + 1).Clear 'efface le contenu du Bon de Commande précédent
End With
With Sheets("Produits")
    Set plageProd = .Range("A9:G" & .Range("A" & .Rows.Count).End(xlUp).Row)
End With
With Sheets("Bon de commande")
    For Each cell In plageProd.Offset(, 6)
        If cell Then
            Sheets("Produits").Range("A" & cell.Row & ":G" & cell.Row).Copy
            .Range("A" & .Range("A" & .Rows.Count).End(xlUp).Row + 1).PasteSpecial Paste:=xlPasteValues
            .Range("H" & .Range("A" & .Rows.Count).End(xlUp).Row).FormulaR1C1 = "=RC[-1]*RC[-2]"
        End If
    Next cell
End With
Application.ScreenUpdating = True
Application.CutCopyMode = False
End Sub

Si ok et terminé, merci de cloturer le fil en cliquant sur le petit V en haut à droite lors de votre réponse

Cordialement

Super, Merci c'est exactement ce que j'avais besoin,

je cloture, et mnt je vais comprendre comment c'est construit

Bonjour,

Une autre proposition.

Les données ont été mises sous forme de tableau.

Cdlt.

Option Explicit

Public Sub Panier()
Dim rCell As Range, rng As Range

    Application.ScreenUpdating = False

    With Worksheets("Bon de commande").ListObjects(1)
        If Not .DataBodyRange Is Nothing Then .DataBodyRange.Delete
        Set rCell = .InsertRowRange.Cells(1)
    End With

    With Worksheets("Produits").ListObjects(1)
        If .ShowAutoFilter Then .AutoFilter.ShowAllData
        .Range.AutoFilter field:=7, Criteria1:=">0"
        With .AutoFilter.Range
            On Error Resume Next
            Set rng = .Offset(1, 0).Resize(.Rows.Count - 1, .Columns.Count) _
                      .SpecialCells(xlCellTypeVisible)
            On Error GoTo 0
            If rng Is Nothing Then
                MsgBox "Il n'y a pas de données à copier!..."
            Else
                rng.Copy
                rCell.PasteSpecial xlPasteValuesAndNumberFormats
                Application.CutCopyMode = 0
            End If
        End With
        .Range.AutoFilter field:=7
    End With

    Worksheets("Bon de commande").Activate

End Sub

Public Sub RAZ()

    With Worksheets("Bon de commande").ListObjects(1)
        If Not .DataBodyRange Is Nothing Then .DataBodyRange.Delete
    End With

End Sub