dupliquer une ligne sur une plage cellule si condition

[idemanz7]

Bonjour,
débutant sur VBA, j'ai besoin de votre aide
j'ai un code qui permet de gérer 2 colonnes de mon tableau et dupliquer enJ si condition.
La condition c'est si il trouve un "/" sur mes données qui sont de format (0000/00) il duplique en 2 cellule la colonne "A" et son résultat la colonne "B" , à la base la colonne B est vide.
j'ai deux variantes sur ma colonne "A" format "0000/00" si ce n'est "0000"
quoi que quand je duplique la colonne "A" et "B" les autres colonnes de mon tableau ne duplique pas et du coup ça crée un décalage sur mes données

voici le code que j'utilise :

Sub copy_numerisation()
Dim dl As Long, pl  As Range, c  As Range, T            'pl=plage  'c=cellule  'dl=dernière ligne
  If Range("B2").Text <> "" Then Exit Sub ' --->> pour ne pas risquer de refaire sur ce qui est fait.
  dl = Range("A" & Rows.Count).End(xlUp).Row
  Range("B2:B" & Rows.Count).NumberFormat = "0000"
  Set pl = Range("A2:A" & dl)

    ReDim T(1 To dl + WorksheetFunction.CountIf(pl, "*/*"), 1 To 2)
  ou = 1
  For Each c In pl
    T(ou, 1) = c.Text
    pos = InStr(c.Text, "/")
    If pos = 0 Then
      T(ou, 2) = c.Text: ou = ou + 1
    Else
  
      T(ou, 1) = c.Text
      T(ou, 2) = Left(c.Text, pos - 1)
      T(ou + 1, 1) = c.Text
      T(ou + 1, 2) = Left(c.Text, 2) & Mid(c.Text, pos + 1)
      ou = ou + 2
    End If
  Next
  Range("A2:B" & UBound(T, 1)).Value = T
  Range("A2:A" & Rows.Count).NumberFormat = "0000"
End Sub

voila un exemple de décalage de mes données, sur les lignes en jaune, normalement je dois avoir la même valeur sur ma colonne D "Relation"

Tous aide sera précieux Merci !

 

[vgendron]

Bonjour
Je ne comprend pas bien le besoin.
il faudrait déjà que tu postes un fichier exemple avec les données de départ et en montrant le résultat attendu en expliquant clairement comment y arriver..

 

[idemanz7]

voilà mon fichier de départ en pièce jointe avec la macro que j'utilise

âpres exécution de ma macro, quelques cellules de ma colonne A sont dupliquées enJ mais les autres colonnes de mon tableau restent figées.
Je cherche à dupliquer (insérer une nouvelle cellule J+1 et copier la valeurs de J sur l'ensemble de mes autres colonnes (C D E F etc),pour chaque ligne dupliquer en cellule de la colonne A

 

[vgendron]

Désolé. je ne comprend rien..
, quelques cellules de ma colonne A sont dupliquées enJ mais les autres colonnes de mon tableau restent figées.

enJ: ca veut dire quoi? en colonne J ?? (dans la colonne J de ta feuille1, il n'y rien. ni avant ni après la macro
enJ = en ligne J ??

exemple la ligne 159 qui contient en colonne A (8570/71)
après la macro, il y a bien une ligne qui a été ajoutée pour obtenir: dans la colonne B: en ligne 159: 8570 et en ligne 160: 8571
les autres colonnes restent inchangées: ATL - 421 et 33 partout..
est ce ceci qui pose problème?

explique clairement ce que tu souhaites en prenant la ligne 159 en exemple..

 

[vgendron]

Peut etre ceci....

Sub Copy2()
Dim TabInit() As Variant
Dim TabFinal() As Variant

With ActiveSheet
    dl = .Range("A" & .Rows.Count).End(xlUp).Row
    TabInit = .Range("A2:J" & dl).Value
    Set pl = Range("A2:A" & dl)
    ReDim TabFinal(1 To dl + WorksheetFunction.CountIf(pl, "*/*"), 1 To UBound(TabInit, 2))
    IndF = 1
    For i = LBound(TabInit, 1) To UBound(TabInit, 1)
        pos = InStr(TabInit(i, 1), "/")
        If pos = 0 Then 'pas de "/"
            For j = LBound(TabInit, 2) To UBound(TabInit, 2)
                TabFinal(IndF, j) = TabInit(i, j)
            Next j
            IndF = IndF + 1
        Else
            TabFinal(IndF, 1) = TabInit(i, 1)
            TabFinal(IndF, 2) = Split(TabInit(i, 1), "/")(0)
            For j = 3 To UBound(TabInit, 2)
                TabFinal(IndF, j) = TabInit(i, j)
            Next j
           
            TabFinal(IndF + 1, 1) = TabInit(i, 1)
            TabFinal(IndF + 1, 2) = Left(Split(TabInit(i, 1), "/")(0), 2) & Split(TabInit(i, 1), "/")(1)
           
            For j = 3 To UBound(TabInit, 2)
                TabFinal(IndF + 1, j) = TabInit(i, j)
            Next j
            IndF = IndF + 2
           
        End If
       
    Next i
   
  .Range("A2:J" & UBound(TabFinal, 1)).Value = TabFinal
  .Range("A2:A" & .Rows.Count).NumberFormat = "0000"
End With

End Sub

 

[idemanz7]

il n'y a pas de ligne qui s'ajoute le code ajoute juste des cellules sur la colonne A et B et cela décale ma colonne C
voilà un cas de départ
ligne/colonne colonne A colonne B colonne C
Ligne 159 8570/71 vide au départ 421
Ligne 160 8572 vide au départ 400
Ligne 161 401

quand ma macro transforme en colonne A la ligne 159 (8570/71) je retrouve :

ligne/colonne colonne A colonne B Colonne C
ligne 159 8570/71 8570 421
Ligne 160 8570/71 8571 411
Ligne 161 8572 8752 401

vous voyez bien le décalage de mes données en colonne C, je cherche à insérer toute une ligne enfaite en copiant les données de ma ligne précédente dans ma nouvelle
résultat souhaité comme exemple
ligne/colonne colonne A colonne B Colonne C
ligne 159 8570/71 8570 421
Ligne 160 8570/71 8571 421
Ligne 161 8572 8752 411
Ligne 162 401

 

[idemanz7]

ça marche bien j'ai rajouté ce même code a la fin de mon code de départ le seul soucis c'est que je perd mes données de la colonne A (ceux qui sont en format 0000/00)

normalement la colonne A doit afficher
(prenons la première ligne du tableau ci dessus comme début)
Colonne A
8570/71 à la place de 0121
8570/71 à la place de 0121

 

[idemanz7]

et ça fait aussi 4 insertion (copie) pour la colonne A et et 2 pour la colonne B

je pense qu'il faut modifié sur le code de départ j'ai essayé depuis ce matin mais j'arrive pas insérer ma boucle

 

[vgendron]

Bonjour
Je ne sais pas ce que tu as modifié, mais chez moi.. avec le code proposé (macro Copy2) ca fait ce qui est demandé..(du moins.. selon ce que j'ai compris..) ==> la colonne A reste comme à l'init, et les lignes sont bien insérées..

 

[idemanz7]

Effectivement ça marche ! super je te remercie pour ton aide.
par contre je voulais récupérer tous mes données de la cellule A dans B y compris les cellules de format "0000"
j'ai rajouté un boue de code au début de ton code et ça marche bien.

Sub Copy2()
Dim TabInit() As Variant
Dim TabFinal() As Variant
'code ajouté
x = ActiveSheet.Name
Set FL1 = Worksheets(x)
For Nolig = 2 To Split(FL1.UsedRange.Address, "$")(4)
mot = Cells(Nolig, 1)
i = InStr(mot, "/")
If i = 0 Then
Cells(Nolig, "B") = Cells(Nolig, "A")

Else
Application.ScreenUpdating = False
End If
Next Nolig
With ActiveSheet ...... 'ton code

comme ça je récupère tous mes données dans la colonne B.
Si y a possibilité d'améliorer ce petit boue de code je suis prenant, mais sinon ça résolue mon problème
Merci encore une fois
Bien à toi ,

 

[vgendron]

Ok.. je viens de comprendre..
plutot que d'ajouter une boucle qui travaille sur la feuille (exécution longue) il vaut mieux modifier le code qui travaille sur des tableaux (beaucoup plus rapide)

Sub Copy2()
Dim TabInit() As Variant
Dim TabFinal() As Variant
If Range("B2").Text <> "" Then Exit Sub ' --->> pour ne pas risquer de refaire sur ce qui est fait.
With ActiveSheet
    dl = .Range("A" & .Rows.Count).End(xlUp).Row 'récupère la dernière ligne de la feuille
    TabInit = .Range("A2:J" & dl).Value 'on place toute la feuille dans un tableau (sauf la ligne d'entete)
    Set pl = Range("A2:A" & dl) 'set plage =colonne A
    ReDim TabFinal(1 To dl + WorksheetFunction.CountIf(pl, "*/*"), 1 To UBound(TabInit, 2)) 'on dimensionne le tablo final : taille tablo Init + nb de lignes à insérer (=nb de "/")
    IndF = 1 'initialisation de l'indice sur tablo Final
    For i = LBound(TabInit, 1) To UBound(TabInit, 1) 'pour chaque ligne du tablo Init
        pos = InStr(TabInit(i, 1), "/") 'recherche du caractère "/"
        If pos = 0 Then 'pas de "/"
            TabInit(i, 2) = TabInit(i, 1) 'on recopie la colonne A en colonne B dans le Tablo Init
            For j = LBound(TabInit, 2) To UBound(TabInit, 2) 'on recopie toutes les colonnes de la ligne
                TabFinal(IndF, j) = TabInit(i, j)
            Next j
            IndF = IndF + 1
        Else
            TabFinal(IndF, 1) = TabInit(i, 1)
            TabFinal(IndF, 2) = Split(TabInit(i, 1), "/")(0)
            For j = 3 To UBound(TabInit, 2)
                TabFinal(IndF, j) = TabInit(i, j)
            Next j
          
            TabFinal(IndF + 1, 1) = TabInit(i, 1)
            TabFinal(IndF + 1, 2) = Left(Split(TabInit(i, 1), "/")(0), 2) & Split(TabInit(i, 1), "/")(1)
          
            For j = 3 To UBound(TabInit, 2)
                TabFinal(IndF + 1, j) = TabInit(i, j)
            Next j
            IndF = IndF + 2
        End If
    Next i
  .Range("A2:J" & UBound(TabFinal, 1)).Value = TabFinal
  .Range("A2:B" & .Rows.Count).NumberFormat = "0000"
End With
End Sub

 

[idemanz7]

Je te remercie infiniment ! c'est bien ce que je cherche comme résultat.

 

[idemanz7]

re bonjour,

Je reviens vers toi pour un autre coup de main stp, le code il marche parfaitement bien, par ailleurs j'essaye d'adapter ce code sur mon fichier d'origine (avec un Tableau de même dimension) qui part d'une colonne "H" pour donner un résultat sur colonne "G" (sens inverse)

c'est un peu trop demandé de ma part quoi que j'ai vraiment essayé d'adapter mais c'est un code très complique pour moi.


je te met en pièce jointe mon classeur avec les quelques modification que j'ai pu apporter au code pour l'adapter et quelques commentaires ( en asseyant de comprendre la logique du code).

 

[vgendron]

Voici le code à utiliser
j'ai ajouté des commentaires pour t'aider à la compréhension

Sub Copy2()
Dim TabInit() As Variant
Dim TabFinal() As Variant

If Range("G2").Text <> "" Then Exit Sub ' --->> pour ne pas risquer de refaire sur ce qui est fait.
With ActiveSheet 'dans la feuille active : evite les .activate, ou autre .select
     dl = .Range("H" & .Rows.Count).End(xlUp).Row 'récupère la dernière ligne de la feuille
     TabInit = .Range("A2:R" & dl).Value 'on place toute la feuille dans un tableau (sauf la ligne d'entete) colonnes A à R
     Set pl = Range("H2:H" & dl) 'set plage =colonne H
     ReDim TabFinal(1 To dl + WorksheetFunction.CountIf(pl, "*/*"), 1 To UBound(TabInit, 2)) 'on dimensionne le tablo final : taille tablo Init + nb de lignes à insérer (=nb de "/")
     IndF = 1 'initialisation de l'indice sur tablo Final
     For i = LBound(TabInit, 1) To UBound(TabInit, 1) 'pour chaque ligne du tablo Init
         pos = InStr(TabInit(i, 8), "/") 'recherche du caractère "/"
         If pos = 0 Then 'pas de "/"
             TabInit(i, 7) = TabInit(i, 8) 'on recopie la colonne H en colonne G dans le Tablo Init
             For j = LBound(TabInit, 2) To UBound(TabInit, 2) 'on recopie toutes les colonnes de la ligne
                 TabFinal(IndF, j) = TabInit(i, j)
             Next j
             IndF = IndF + 1
         Else
         '1ere ligne nouvelle avec partie AVANT "/"
             TabFinal(IndF, 8) = TabInit(i, 8)                 'colonne H du tablo final prend la colonne H du TabInit
             TabFinal(IndF, 7) = Split(TabInit(i, 8), "/")(0) 'on sépare (split) la valeur de la colonne H pour prendre la première partie (0) avant le /
             
             For j = 1 To UBound(TabInit, 2)                   'pour toutes les colonnes du tableau==> on recopie les éléments qui ne doivent pas bouger
                If j <> 7 And j <> 8 Then 'pour ne pas effacer les colonne G et H qu'on vient de traiter au dessus
                    TabFinal(IndF, j) = TabInit(i, j)
                End If
             Next j
        '2eme ligne nouvelle avec partie APRES "/"
             TabFinal(IndF + 1, 8) = TabInit(i, 8)              'colonne H du tablo final prend la colonne H du TabInit
             TabFinal(IndF + 1, 7) = Left(Split(TabInit(i, 8), "/")(0), 2) & Split(TabInit(i, 8), "/")(1)
           
             For j = 1 To UBound(TabInit, 2)                   'pour toutes les colonnes du tableau==> on recopie les éléments qui ne doivent pas bouger
                If j <> 7 And j <> 8 Then 'pour ne pas effacer les colonne G et H qu'on vient de traiter au dessus
                    TabFinal(IndF + 1, j) = TabInit(i, j)
                End If
             Next j
             IndF = IndF + 2
         End If
     Next i
   .Range("A2:R" & UBound(TabFinal, 1)).Value = TabFinal 'on recopie le tablo final dans la feuille
   .Range("G2:H" & .Rows.Count).NumberFormat = "0000" 'on applique le format "000" sur les deux colonnes G et H
End With
End Sub

 

[idemanz7]

Super ! c'est très généreux de ta part.
A la fois j'ai un code avec le résultat souhaité mais j'ai aussi pu comprendre le code en question (ça tombe bien on est là pour apprendre ), je tenais à te remercier encore une fois infiniment pour ce précieux aide
sur ce je te souhaite un bonne soirée et à une autre fois

Bien à toi Vgendron,