Insertion lignes sous conditions

Bonjour à tous,

Je fais appel à la communauté car mes connaissance en VBA sont très limitées.

J'ai besoin d'une macro qui puisse copier une sélection puis la coller (valeur) dans une autre feuille.

Ensuite il faudrait que celle-ci duplique les lignes autant de fois que la valeur en colonne O.

Le petit fichier ci-joint est un peu plus explicite.

Merci d'avance pour votre retour.

Bonjour antony44, le forum,

Un essai.....

Sub Test()
 Dim tablo

    Application.ScreenUpdating = False

      tablo = Sheets("Détail besoin").Range("A3").CurrentRegion

      With Sheets("Usiné")
       .Activate
         For i = 2 To UBound(tablo, 1)
            a = tablo(i, 15) - 1
            lgn = .Range("D" & Rows.Count).End(xlUp).Row + 1
           For j = 4 To 18
            .Range(Cells(lgn, j), Cells(lgn + a, j)) = tablo(i, j - 1)
           Next j
         Next i
      End With
End Sub

CTRL + e pour lancer la macro "Test".

Cordialement,

Bonjour,

Merci pour cette réponse rapide et efficace.

Cela semble fonctionner gobalement.

La macro prend par contre toutes les lignes du tableau feuille "détail besoin".

Je ne veux prendre que les lignes sélectionnées.

Comment corriger cela ?

Re,

Merci pour ton retour,

Je ne veux prendre que les lignes sélectionnées.

Peut-être ainsi....(si les lignes sont sélectionnées par bloc)....

Sub Test()
 Dim tablo, lignedeb, lignefin

    Application.ScreenUpdating = False

    With selection '.................................selectionner les lignes
     lignedeb = .Row '...............................première ligne
     lignefin = lignedeb + .Rows.Count - 1 '.........dernière ligne
     tablo = Sheets("Détail besoin").Range("A" & lignedeb & ":Q" & lignefin) '..tableau de données
    End With

      With Sheets("Usiné")
       .Activate
         For i = 1 To UBound(tablo, 1)
          If tablo(i, 2) <> "" Then
            a = tablo(i, 15) - 1
            lgn = .Range("D" & Rows.Count).End(xlUp).Row + 1
           For j = 4 To 18
            .Range(Cells(lgn, j), Cells(lgn + a, j)) = tablo(i, j - 1)
           Next j
          End If
         Next i
      End With
End Sub

Cordialement,

Re,

Si tu sélectionnes tes lignes via la colonne A, en mettant un "x" par exemple....

Option Compare Text
Sub Test()
 Dim tablo

    Application.ScreenUpdating = False

      tablo = Sheets("Détail besoin").Range("A3").CurrentRegion

      With Sheets("Usiné")
       .Activate
         For i = 2 To UBound(tablo, 1)
          If tablo(i, 1) = "x" Then
            a = tablo(i, 15) - 1
            lgn = .Range("D" & Rows.Count).End(xlUp).Row + 1
           For j = 4 To 18
            .Range(Cells(lgn, j), Cells(lgn + a, j)) = tablo(i, j - 1)
           Next j
          End If
         Next i
      End With
End Sub

Cordialement,

Super, merci pour ces solutions. Cela fonctionne bien et rapidement.

Je me permets une demande supplémentaire à intégrer à cette macro.

Je voudrais maintenant trier les lignes qui ont été copiées et insérées dans cette nouvelle feuille (et uniquement elles) par couleur, puis priorité, puis client, puis équipement.

Merci d'avance pour votre retour.

Bonjour,

Y at'il une âme charitable pour trier ces lignes après insertion.

Merci d'avance.