Remplir un bon de commande

[degap05]

Bonjour le forum,

J'ai besoin d'aide pour réaliser un bon de commande simple à partir d'une liste de références.
Les lignes à commander sont cochées, puis envoyées vers le récapitulatif à la validation.

Merci.

 

[mromain]

Re : Remplir un bon de commande

bonjour degap05,

je te propose cette macro :

Private Sub CommandButton1_Click()
Dim shtSrc As Worksheet, shtDest As Worksheet, i As Integer, lastLine As Integer
Set shtSrc = ThisWorkbook.Sheets("Dot")
Set shtDest = ThisWorkbook.Sheets("Cde")
'effacer les saisie dans la feuille "Cde"
shtDest.Range(shtDest.Range("A4"), shtDest.Range("A4").End(xlToRight).End(xlDown)).ClearContents
lastLine = shtDest.Range("A" & shtDest.Rows.Count).End(xlUp).Row + 1
'boucler sur les éléments de la feuille "Dot"
For i = 3 To shtSrc.Range("D" & shtSrc.Rows.Count).End(xlUp).Row
    If UCase(shtSrc.Range("D" & i)) = "X" Then
        shtDest.Range("A" & lastLine).Value = shtSrc.Range("A" & i).Value
        shtDest.Range("B" & lastLine).Value = shtSrc.Range("B" & i).Value
        shtDest.Range("C" & lastLine).Value = shtSrc.Range("C" & i).Value
        lastLine = lastLine + 1
    End If
Next i
shtSrc.Range("D3:D60").ClearContents
shtSrc.Range("F2") = Now
End Sub

a+

 

[Dull]

Re : Remplir un bon de commande

Salut Degap05, Romain🙂, Le Forum,

la même chose un tout petit peu plus court 😉

Private Sub CommandButton1_Click()
Dim C As Range
Sheets("Cde").Range("A5:C100").ClearContents
For Each C In Range("A3:D60") [COLOR=Green]' Peut être amélioré[/COLOR]
    If C = "X" Then
        With Sheets("Cde").Range("A65536").End(xlUp)
            .Offset(1, 0) = C.Offset(0, -3)
            .Offset(1, 1) = C.Offset(0, -2)
            .Offset(1, 2) = C.Offset(0, -1)
        End With
    End If
Next C
Range("D3:D60").ClearContents
Range("F2") = Now()
End Sub

Bonne Journée

 

[degap05]

Re : Remplir un bon de commande

Bonjour, mromain et Dull,

Je viens d'essayer vos solutions, elles fonctionnent parfaitement.

Mon problème est résolu.

Merci à tous les deux.

A+