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