VBA: Dupliquer des lignes sous condition

[benoit78530]

Bonjour,

Je suis débutant en VBA et je cherche à faire une macro qui me permettrai de dupliquer des lignes d'une base type code article, désignation article pour les lignes contenant la valeur 1 dans le champs "A dupliquer".


Ci-joint l'exemple avec la base de départ et la base de fin

Merci d'avance

 

[Guest]

Re : VBA: Dupliquer des lignes sous condition

Bonjour,

Ton classeur en retour avec une macro 'cmdDupliquer'

A+

[Edit] je viens de rééditer le fichier pour simplifier le test des lignes à dupliquer ou non.

Public Sub cmdDupliquer()
    Dim derLig As Long, lg As Long
    Dim shTo As Worksheet, shFrom As Worksheet
    
    Set shFrom = Sheets("Base 1 Départ")
    Set shTo = Sheets("Base 2 Résultat")
    
    'Tester dernière ligne de feuille source
    derLig = shFrom.Cells(Rows.Count, 1).End(xlUp).Row
    If derLig < 2 Then Exit Sub
    
    For lg = 2 To derLig
        With shTo.Cells(Rows.Count, 1).End(xlUp)(2)
            .Resize(2 + (shFrom.Cells(lg, 3) = 0), 3).Value = shFrom.Cells(lg, 1).Resize(, 3).Value
        End With
    Next
End Sub

Hello Reobert

 

[Robert]

Re : VBA: Dupliquer des lignes sous condition

Bonjour Benoit et bienvenu, bonjour hasco, bonjour le forum,

Trop tard ! Mais comme j'y ai aussi planché, je t'envoie quand même ma proposition :

Sub Macro1()
Dim O1 As Object 'déclare la variable O1 (Onglet 1)
Dim O2 As Object 'déclare la variable O2 (Onglet 2)
Dim DL As Integer 'déclare la variable DL (Dernière Ligne)
Dim PL As Range 'déclare la variable PL (PLage)
Dim CEL As Range 'déclare la variable CEL (CELlule)
Dim X As Byte 'déclare la variable X
Dim Dest As Range 'déclare la variable Dest (cellule de Destination)

Set O1 = Sheets("Base 1 Départ") 'définit l'onglet O1
Set O2 = Sheets("Base 2 Résultat") 'définit l'onglet O2
DL = O1.Cells(Application.Rows.Count, 1).End(xlUp).Row 'définit la dernière ligne éditée DL de la colonne 1 (=A) de l'onglet O1
Set PL = O1.Range("A2:A" & DL) 'définit la plage PL
For Each CEL In PL 'boucle 1 : sur toutes les cellules CEL de la palge PL
    For X = 1 To CByte(CEL.Offset(0, 2).Value) + 1 'boucle 2 : de 1 au nombre indiqué en colonne C plus un
        Set Dest = O2.Cells(Application.Rows.Count, 1).End(xlUp).Offset(1, 0) 'définit la cellule de destination Dest
        CEL.Resize(1, 3).Copy Dest 'copie la ligne et la colle dans Dest
    Next X 'prochaine fois de la bouicle 2
Next CEL 'prochaine cellule de la boucle 1
End Sub

 

[laetitia90]

Re : VBA: Dupliquer des lignes sous condition

bonjour benoit ,Hasco,Robert
une version tablo

Sub es()
 Dim t(), t1(), x As Long, i As Long, k As Long, z As Long
 t = Feuil1.Range("a2:c" & Feuil1.Cells(Rows.Count, 1).End(3).Row)
 x = 1
 For i = 1 To UBound(t)
 For z = 1 To t(i, 3) + 1
 ReDim Preserve t1(1 To 3, 1 To x)
 For k = 1 To 3
 t1(k, x) = t(i, k)
 Next k: x = x + 1: Next z: Next i
 Feuil2.[a2].Resize(x - 1, 3) = Application.Transpose(t1)
End Sub

 

[benoit78530]

Re : VBA: Dupliquer des lignes sous condition

Merci à vous trois pour votre aide, c'est parfait!
Faut que je me mette serieusement à VBA!

A+