Résolu Creat° Macro pour dupliquer des lignes avec conditions

[Mrik117]

Bonjour à tous,

Je cherche à créer une macro sur excel en vba qui me permette de faire le détail par année pour un fichier de contrat.
j'ai donc un numéro de contrat par ligne et leurs (dates de débuts, durées, coûts,...) en colonne.
Le but étant d'ajouter pour les contrats d'une durée supérieur à 12 mois une ligne par année en dupliquant les champs .(dates de débuts, durées, coûts..).
Ex: pour un contrat d'une durée de 36 mois débutant le 01/01/2013 pour un coût totale de 1500€, d'obtenir trois lignes:

01/01/2013-01/01/2014 coûts 500€
01/01/2014-01/10/2015 coûts 500€
01/10/2015-01/10/2016 coûts 500€
Merci

 

[Paritec]

Re : Creat° Macro pour dupliquer des lignes avec conditions

bonjour Mrik117 le forum
et tu penses que le fichier exemple nous devons le faire ??? ou alors on attend un peu que tu le fasses????
a+
Papou

 

[Mrik117]

Re : Creat° Macro pour dupliquer des lignes avec conditions

Bonjour,
Effectivement je ne connais pas encore bien les traditions.
Je transmet ça tout de suite.
Sur le premier feuillet un exemple de mon fichier actuel et sur le deuxieme ce que je souhaiterai obtenir.

Merci pour ta réponse

Regarde la pièce jointe exemple.xlsx

 

[Mrik117]

Re : Creat° Macro pour dupliquer des lignes avec conditions

Voici mon code brute qui me permet de dupliquer les lignes autant de fois qu'il est necessaire suivant la durée.

Sub ChgtNom()
    Dim i As Integer
    Dim k As Integer
    For i = Range("D65536").End(xlUp).Row To 2 Step -1
       
       ' Pour plus de 12 mois
        If Cells(i, 8).Value > 12 And Cells(i, 8).Value <= 24 Then
            Cells(i, 8).Offset(1, 0).EntireRow.Insert , CopyOrigin:=xlFormatFromRightOrBelow
            'Cells(i + 1, 8).EntireRow.Insert , CopyOrigin:=xlFormatFromLeftOrAbove
          
            Range(i + 1 & ":" & i).Interior.ColorIndex = 4
            
                    Rows(i).Select
                    Selection.Copy
                    Rows(i + 1).Select
                    ActiveSheet.Paste
                            
        End If
      
      
      ' Pour plus de 24 mois
       If Cells(i, 8).Value > 24 And Cells(i, 8).Value <= 36 Then
            k = 2
            'Cells(i, 8).Offset(1, 0).EntireRow.Insert , CopyOrigin:=xlFormatFromRightOrBelow
            Cells(i + k - 1, 8).EntireRow.Insert , CopyOrigin:=xlFormatFromLeftOrAbove
            Cells(i + k, 8).EntireRow.Insert , CopyOrigin:=xlFormatFromLeftOrAbove
           
            Range(i + k & ":" & i).Interior.ColorIndex = 5
             Rows(i).Select
                    Selection.Copy
                    Rows(i + 1).Select
                    ActiveSheet.Paste
                    Rows(i + 2).Select
                    ActiveSheet.Paste
                            
        End If
  
   'Pour plus de 36 mois
       If Cells(i, 8).Value > 36 And Cells(i, 8).Value <= 48 Then
            k = 4
            'Cells(i, 8).Offset(1, 0).EntireRow.Insert , CopyOrigin:=xlFormatFromRightOrBelow
            Cells(i + k - 3, 8).EntireRow.Insert , CopyOrigin:=xlFormatFromLeftOrAbove
            Cells(i + k - 2, 8).EntireRow.Insert , CopyOrigin:=xlFormatFromLeftOrAbove
            Cells(i + k - 1, 8).EntireRow.Insert , CopyOrigin:=xlFormatFromLeftOrAbove
            
            Range(i + k & ":" & i).Interior.ColorIndex = 7
            Rows(i).Select
                    Selection.Copy
                    Rows(i + 1).Select
                    ActiveSheet.Paste
                    Rows(i + 2).Select
                    ActiveSheet.Paste
                    Rows(i + 3).Select
                    ActiveSheet.Paste
                   
            End If
    
            
      
       'Pour plus de 48 mois
      
        If Cells(i, 8).Value > 48 And Cells(i, 8).Value <= 60 Then
            k = 5
            'Cells(i, 8).Offset(1, 0).EntireRow.Insert , CopyOrigin:=xlFormatFromRightOrBelow
             Cells(i + k - 4, 8).EntireRow.Insert , CopyOrigin:=xlFormatFromLeftOrAbove
              Cells(i + k - 3, 8).EntireRow.Insert , CopyOrigin:=xlFormatFromLeftOrAbove
               Cells(i + k - 2, 8).EntireRow.Insert , CopyOrigin:=xlFormatFromLeftOrAbove
                Cells(i + k - 1, 8).EntireRow.Insert , CopyOrigin:=xlFormatFromLeftOrAbove
            
            Range(i + k & ":" & i).Interior.ColorIndex = 8
                  Rows(i).Select
                    Selection.Copy
                    Rows(i + 1).Select
                    ActiveSheet.Paste
                    Rows(i + 2).Select
                    ActiveSheet.Paste
                    Rows(i + 3).Select
                    ActiveSheet.Paste
                    Rows(i + 4).Select
                    ActiveSheet.Paste
                    
            End If
           
         'Pour plus de 60 mois
        If Cells(i, 8).Value > 60 And Cells(i, 8).Value <= 72 Then
            k = 6
            'Cells(i, 8).Offset(1, 0).EntireRow.Insert , CopyOrigin:=xlFormatFromRightOrBelow
            Cells(i + k - 5, 8).EntireRow.Insert , CopyOrigin:=xlFormatFromLeftOrAbove
            Cells(i + k - 4, 8).EntireRow.Insert , CopyOrigin:=xlFormatFromLeftOrAbove
            Cells(i + k - 3, 8).EntireRow.Insert , CopyOrigin:=xlFormatFromLeftOrAbove
            Cells(i + k - 2, 8).EntireRow.Insert , CopyOrigin:=xlFormatFromLeftOrAbove
            Cells(i + k - 1, 8).EntireRow.Insert , CopyOrigin:=xlFormatFromLeftOrAbove
            
            Range(i + k & ":" & i).Interior.ColorIndex = 10
            
                Rows(i).Select
                    Selection.Copy
                    Rows(i + 1).Select
                    ActiveSheet.Paste
                    Rows(i + 2).Select
                    ActiveSheet.Paste
                    Rows(i + 3).Select
                    ActiveSheet.Paste
                    Rows(i + 4).Select
                    ActiveSheet.Paste
                    Rows(i + 5).Select
                    ActiveSheet.Paste
                   
            
            End If
      
      
        
    Next
End Sub

 

[Staple1600]

Re : Creat° Macro pour dupliquer des lignes avec conditions

Bonsoir à tous


L'épidémie est même fulgurante et exponentielle.
Je vais finir par casser mes touches CTRL+C et CTRL V

Creat° Macro pour dupliquer des lignes avec conditions : Excel - VBA

Donc pour comprendre de quoi je parle.

 

[bbb38]

Re : Creat° Macro pour dupliquer des lignes avec conditions

Bonjour Papou, JM, le forum,
J’ai apprécié vos commentaires. J’attends maintenant les solutions, et améliorer ainsi le petit fichier d’exemple que j’ai réalisé avec les éléments du premier message (mais quelle erreur).
Cordialement,
Bernard
P .S. JM : Verve sublime. Magnifique plaidoirie.

 

[Mrik117]

Re : Creat° Macro pour dupliquer des lignes avec conditions

Bonjour,
Je ne suis pas un grand habitué des forums je n'ai donc pas encore tous les réflexes.
J'ai posté mon sujet sur excel-download lorsque j'ai eu pour seul réponse sur le forum excel-pratique; "Pas possible" j'ai donc pensé que mon sujet était enterré et suis venu chercher de l'aide ici.

Je m'excuse pour tous les désagréments que j'ai causés.

J’espère toutefois que je pourrai encore bénéficier d'aide sur ce forum

Cordialement,

 

[Staple1600]

Re : Creat° Macro pour dupliquer des lignes avec conditions

Bonjour à tous

Mrik117
Le problème n'est pas de poser une question sur plusieurs forums.
mais c'est, dirai-je, plus sympa de le signaler (en mettant un lien)
Et cela évite surtout de passer du temps à cogiter une solution qui peut-être existe déjà ailleurs.
Je suppose que tu n'as cliqué sur les liens dans mon précédent message (car ceux-ci expliquaient déjà cela)

PS: Ne t’inquiètes pas, tu ne seras ni pendu haut et court, ni ostracisé.
Et oui, on t'apportera de l'aide pour tes prochaines questions.

(Mais si tu crosspostes, n'oublie pas de le signaler.)

 

[Paritec]

Re : Creat° Macro pour dupliquer des lignes avec conditions

Bonjour Mrik117 le forum
bon alors moi je ne suis pas trop d'accord avec le publipostage, mais bon on va dire que tu ne le savais pas et que tu ne le feras plus !!!
ton fichier en retour avec une feuille test, tu ouvres tu cliques le bouton sur la feuille traiter et tu me redis
a+
Papou

 

[Mrik117]

Re : Creat° Macro pour dupliquer des lignes avec conditions

Bonjour Papou,
je pense que je peux fermer ce sujet et le mettre en résolu, pour ne garder qu'un seul forum actif.
Cordialement,
Et merci