Dupliquer ligne avec condition

[cheikh]

Bonjour,
Je veux adapter une macro qui doit me permettre de dupliquer une ligne entière si le dernier champs de la ligne est renseigné (voire exemple dans Feuil2).
Dans la Feuil1 il existe déjà une macro qui permet de faire un duplication de ligne en plusieurs en se basant sur les ";".
Les deux problématiques sont assez semblables mais je n'arrive pas à l'adapter pour mon cas.
J'ai mis les deux exemples en pj.
Merci d'avance.

 

[Dranreb]

Re : Dupliquer ligne avec condition

Bonjour.
Comme ça :

Sub Duplique()
Dim TE(), LE&, TS(), LS&, C&
TE = ActiveSheet.[A1].CurrentRegion.Value
ReDim TS(1 To 5000, 1 To 6)
For LE = 2 To UBound(TE, 1)
   LS = LS + 1
   For C = 1 To 6: TS(LS, C) = TE(LE, C): Next C
   If Not IsEmpty(TE(LE, 7)) Then
      LS = LS + 1
      For C = 1 To 5: TS(LS, C) = TE(LE, C): Next C
      TS(LS, 6) = TE(LE, 7): End If: Next LE
ActiveSheet.[A14].Resize(LS, 6).Value = TS
End Sub

 

[Modeste]

Re : Dupliquer ligne avec condition

Bonjour cheikh,

Une solution (parmi bien d'autres) ...

Effacer les données sous le tableau de départ avant de poursuivre. Le résultat sera collé en colonne J à O.

Sub dupliqueCA()
Dim tablo()
With Sheets("Feuil2")
.[J:O].EntireColumn.ClearContents
.[A1:F1].Copy .[J1]
For lig = 2 To .Cells(Rows.Count, 2).End(xlUp).Row
    For col = 1 To 2
        If .Cells(lig, 5 + col) <> "" Then
            ReDim Preserve tablo(5, i)
            tablo(0, i) = .Cells(lig, 1)
            tablo(1, i) = .Cells(lig, 2)
            tablo(2, i) = .Cells(lig, 3)
            tablo(3, i) = .Cells(lig, 4)
            tablo(4, i) = .Cells(lig, 5)
            tablo(5, i) = .Cells(lig, 5 + col)
            i = i + 1
        End If
    Next col
Next lig
.[J2].Resize(i, 6) = Application.Transpose(tablo)
End With
End Sub

[Edit:] Oupssss, désolé pour le télescopage, Dranreb et accessoirement, bien le bonjour

 

[cheikh]

Re : Dupliquer ligne avec condition

Bonjour Modeste et Dranreb,
Vos deux solution marchent très bien.
Question: est-il possible de ne pas créer une nouvelle plage de données en lançant la macro mais que tout se pas la plage ou tableau initiale.
Encore Merci.

 

[Dranreb]

Re : Dupliquer ligne avec condition

Oui, il suffit de changer la destination [A14] en [A2]

Dimensionnez peut être aussi TS(1 to 5000, 1 To 7) et dans le Resize à la fin aussi, pour que ça efface la colonne 7.

 

[cheikh]

Re : Dupliquer ligne avec condition

Oui, il suffit de channger la destination [A14] en [A2]

Ok ça marche très bien.
Merci encore.

 

[Modeste]

Re : Dupliquer ligne avec condition

Re,

Ça vaut ce que ça vaut ... ma proposition pouvait être modifiée comme suit

Sub dupliqueCA()
Dim tablo()
With Sheets("Feuil2")
titres = Array("civilite", "nom", "nom de jeune fille", "prenom", "date naissance", "CA")
For lig = 2 To .Cells(Rows.Count, 2).End(xlUp).Row
    For col = 1 To 2
        If .Cells(lig, 5 + col) <> "" Then
            ReDim Preserve tablo(5, i)
            tablo(0, i) = .Cells(lig, 1)
            tablo(1, i) = .Cells(lig, 2)
            tablo(2, i) = .Cells(lig, 3)
            tablo(3, i) = .Cells(lig, 4)
            tablo(4, i) = .Cells(lig, 5)
            tablo(5, i) = .Cells(lig, 5 + col)
            i = i + 1
        End If
    Next col
Next lig
.[A:G].EntireColumn.ClearContents
.[A1:F1] = titres
.[A2].Resize(i, 6) = Application.Transpose(tablo)
End With
End Sub:

 

[cheikh]

Re : Dupliquer ligne avec condition

Re,

Ça vaut ce que ça vaut ... ma proposition pouvait être modifiée comme suit

Sub dupliqueCA()
Dim tablo()
With Sheets("Feuil2")
titres = Array("civilite", "nom", "nom de jeune fille", "prenom", "date naissance", "CA")
For lig = 2 To .Cells(Rows.Count, 2).End(xlUp).Row
    For col = 1 To 2
        If .Cells(lig, 5 + col) <> "" Then
            ReDim Preserve tablo(5, i)
            tablo(0, i) = .Cells(lig, 1)
            tablo(1, i) = .Cells(lig, 2)
            tablo(2, i) = .Cells(lig, 3)
            tablo(3, i) = .Cells(lig, 4)
            tablo(4, i) = .Cells(lig, 5)
            tablo(5, i) = .Cells(lig, 5 + col)
            i = i + 1
        End If
    Next col
Next lig
.[A:G].EntireColumn.ClearContents
.[A1:F1] = titres
.[A2].Resize(i, 6) = Application.Transpose(tablo)
End With
End Sub:

Merci Modeste pour les réponses rapides. Le résultat est super.

 

[cheikh]

Re : Dupliquer ligne avec condition

rBonjour,
je reviens vers vous pour savoir si une possibilité peut être prise en compte dans la macro c'est à dire si on peut colorier les nouvelles lignes qui sont dupliquées où écrire quelque chose à côté pour savoir qu'elles ont été dupliquées. En gros une chose simple pour indiquer désigner ces lignes.
Merci d'avance

 

[Dranreb]

Re : Dupliquer ligne avec condition

Bonjour cheikh et Modeste.

Vous pouvez peut être prévoir une colonne supplémentaire pour Now, la date et l'heure de création de la ligne.

 

[cheikh]

Re : Dupliquer ligne avec condition

re,
oui c'est une bonne idée et j'ai essayé avec la macro de Modeste et cette colonne Now me met toutes lignes avec la même date.
En ce qui concerne ta macro qui marche également très bien, c'est plus difficile pour moi de l'adapter car je ne comprends pas cette manière de programmer avec vba en utilisant les tabo .

 

[Dranreb]

Re : Dupliquer ligne avec condition

Pourtant Modeste en utilise aussi un mais seulement pour la sortie, et il ne fait pas de boucle pour les colonnes.
Moi j'en utilise 2: un pour l'entrée et l'autre pour la sortie.
C'est pour ça que je les appelle toujours TE et TS ainsi que leurs indices (de ligne) LE et LS

Il faut mettre Now seulement aux lignes ajoutées. Pour les autres il faut reproduire ce qu'il y a déjà, si j'ai bien compris.

 

[cheikh]

Re : Dupliquer ligne avec condition

re,
cette méthode met toujours temps d'exécution plus court. J'ai essayé de chercher des tuto pour la comprendre mais hélas... En gros c'est fort

 

[Dranreb]

Re : Dupliquer ligne avec condition

Mais qu'est ce que vous ne comprenez pas ?

 

[cheikh]

Re : Dupliquer ligne avec condition

Surtout la syntaxe mais je pense que ça demande aussi de la pratique normalement.
Par exemple lors des déclaration: LE& ...