Macro commander

Bonjour, j'aimerai que dans la macro du bouton "commander" sur la feuille "stock" qu'on puisse commander plusieurs lignes parce que actuellement je peux commander ligne par ligne, il faudrait que ça soit séparé par une virgule sans espace

La macro se situe dans le module 4

Merci d'avance

Bonjour,

Remplaces ton code par celui-ci-dessous :

Sub Commander()

    Dim T
    Dim ligne
    Dim DernLigne As Long
    Dim I As Long

    DernLigne = Sheets("Pièces à commander").Range("A" & Rows.Count).End(xlUp).Row + 1

    ligne = InputBox("Quelle ligne voulez-vous copier ?", "Ligne à copier")

    If ligne = "" Then MsgBox "Vous avez choisi d'annuler !": Exit Sub
    ligne = Replace(ligne, " ", "") '<-- supprime les éventuels espaces
    If Not IsNumeric(ligne) Then MsgBox "Seulement numérique !": Exit Sub

    T = Split(ligne, ",")

    If UBound(T) > 0 Then

        For I = 0 To UBound(T)

            If CLng(T(I)) < 4 Then MsgBox "Seulement à partir de la ligne 4 !": Exit Sub
            If Range("A" & CLng(T(I))).MergeCells Then MsgBox "Vous ne pouvez pas sélectionner la ligne '" & T(I) & "' !": Exit Sub

        Next I

        For I = 0 To UBound(T)

            Sheets("Pièces à commander").Range("A" & DernLigne & ":G" & DernLigne).Value = Range("A" & T(I) & ":G" & T(I)).Value
            DernLigne = DernLigne + 1

        Next I

    Else

        If CLng(ligne) < 4 Then MsgBox "Seulement à partir de la ligne 4 !": Exit Sub
        If Range("A" & CLng(ligne)).MergeCells Then MsgBox "Vous ne pouvez pas sélectionner la ligne '" & ligne & "' !": Exit Sub

        Sheets("Pièces à commander").Range("A" & DernLigne & ":G" & DernLigne).Value = Range("A" & ligne & ":G" & ligne).Value

    End If

    MsgBox "données transférées"

End Sub

Il te faut faire un contrôle des valeurs entrées, j'en ai intégré quelques uns mais à voir si tes utilisateurs risque de saisir autre chose.

Merci beaucoup, mais je peux pas commander plusieurs lignes parce que je peux en commander que 2 avec ta macro.

Et quand on copie 2 lignes par exemple, ça les colles dans la feuille suivante mais si on recommence avec deux autres lignes et ba ça me supprime les deux lignes d'avant . Il faudrait que ça soit à la suite des unes des autres.

Oups,

...mais je peux pas commander plusieurs lignes parce que je peux en commander que 2 avec ta macro.

Effectivement, le contrôle de la valeur numérique doit être fait de façon individuelle dans la boucle !

Code corrigé (voir plus bas pour explication de la présence de la fonction DefPlage) :

Sub Commander()

    Dim T
    Dim ligne
    Dim DernLigne As Long
    Dim I As Long

    If Not DefPlage(Worksheets("Pièces à commander")) Is Nothing Then

        DernLigne = DefPlage(Worksheets("Pièces à commander")).Rows.Count + 1

    Else

        MsgBox "Il y a un problème au niveau de la feuille 'Pièces à commander' !": Exit Sub

    End If

    ligne = InputBox("Quelle ligne voulez-vous copier ?", "Ligne à copier")

    If ligne = "" Then MsgBox "Vous avez choisi d'annuler !": Exit Sub
    ligne = Replace(ligne, " ", "") '<-- supprime les éventuels espaces

    T = Split(ligne, ",")

    If UBound(T) > 0 Then

        For I = 0 To UBound(T)

            If Not IsNumeric(T(I)) Then MsgBox "Seulement numérique !": Exit Sub
            If CLng(T(I)) < 4 Then MsgBox "Seulement à partir de la ligne 4 !": Exit Sub
            If Range("A" & CLng(T(I))).MergeCells Then MsgBox "Vous ne pouvez pas sélectionner la ligne '" & T(I) & "' !": Exit Sub

        Next I

        For I = 0 To UBound(T)

            Sheets("Pièces à commander").Range("A" & DernLigne & ":G" & DernLigne).Value = Range("A" & T(I) & ":G" & T(I)).Value
            DernLigne = DernLigne + 1

        Next I

    Else

        If Not IsNumeric(ligne) Then MsgBox "Seulement numérique !": Exit Sub
        If CLng(ligne) < 4 Then MsgBox "Seulement à partir de la ligne 4 !": Exit Sub
        If Range("A" & CLng(ligne)).MergeCells Then MsgBox "Vous ne pouvez pas sélectionner la ligne '" & ligne & "' !": Exit Sub

        Sheets("Pièces à commander").Range("A" & DernLigne & ":G" & DernLigne).Value = Range("A" & ligne & ":G" & ligne).Value

    End If

    MsgBox "données transférées"

End Sub

Function DefPlage(Fe As Worksheet, Optional L As Long = 1, Optional C As Long = 1) As Range

    On Error GoTo Fin

    With Fe

        Set DefPlage = .Range(.Cells(L, C), _
                       .Cells(.Cells.Find("*", .[A1], -4123, , _
                       1, 2).Row, .Cells.Find("*", .[A1], -4123, , _
                       2, 2).Column))

    End With

    Exit Function

Fin:

    Set DefPlage = Nothing

End Function

Et quand on copie 2 lignes par exemple, ça les colles dans la feuille suivante mais si on recommence avec deux autres lignes et ba ça me supprime les deux lignes d'avant . Il faudrait que ça soit à la suite des unes des autres.

C'est tout à fait normal, car dans ta feuille "Stock" sur la colonne A où est défini la valeur de la variable DerLigne, il y a des "trous" dans les références !

Avec la fonction DefPlage que j'ai rajouté, on recherche vraiment la cellule la plus basse dans la feuille qui contient une valeur et DerLigne est définie par rapport à cette cellule !