XL 2013 Mise en forme avec macro copier ligne

[EveDesLys]

Bonjour à tous,

J'ai une macro pour copier des lignes le nombre de fois indiqué dans une case, mais il ne conserve pas la mise en forme (la couleur des lignes ne reste pas sur les bonnes lignes). Est-ce que vous pouvez m'aider à régler ce problème SVP? Voici le fichier contenant la macro.

Merci d'avance!

 

[sylvanu]

Bonjour EveDesLys,
Un essai en PJ.
Pour le copier coller, j'ai fait simplement :

    For i = dl To 2 Step -1 ' De la dernière ligne jusqu'à la deuxième ligne (on ne prend pas en compte la ligne de titres
      If .Cells(i, 9) > 1 Then ' Si la valeur en colonne 9 (I) est supérieure à 1
        .Rows(i).Copy
        n = .Cells(i, 9) - 1 ' Calcule le nombre de lignes à ajouter
        .Rows(i).Copy           ' Copie les cellules
        .Rows(i).Resize(n).Insert Shift:=xlDown ' Insère le nombre de lignes necessaires et colle par la même occasion
      End If
    Next i

Il copie colle valeurs et format.
Mais n'ayant pas approfondi votre code, je ne sais pas si cela fait exactement ce que vous voulez. 🙂

 

[EveDesLys]

Bonjour,

Merci pour ta réponse. J'ai essayé la macro dans mon fichier original, mais ça pas fonctionné. Ça n'insère pas de nouvelles lignes et ne copie pas tout. Aussi, il y a des nombres dans une colonne où il ne devrait pas y en avoir dans ton fichier. Est-ce qu'il y aurait une autre façon de faire?

Merci beaucoup.

 

[sylvanu]

Mais est ce qu'au moins ma PJ marche ?

 

[EveDesLys]

Non, ça ne semble pas fonctionner

 

[sylvanu]

Avec ma PJ d'après ce que j'avais compris ça donne ça :

 

[job75]

Bonjour EveDesLys, sylvanu, le forum,

Il faut insérer les lignes sous la ligne courante (i) :

Sub CopierLignes2()
Dim i&, n&
Application.ScreenUpdating = False
With Sheets("Hebdo")
    If .FilterMode Then .ShowAllData 'si la feuille est filtrée
    With .[A1].CurrentRegion
        For i = .Rows.Count To 2 Step -1
            n = .Cells(i, 9) - 1
            If n > 0 Then
                .Rows(i + 1).Resize(n).Insert xlDown 'insère les lignes en copiant les formats
                .Rows(i + 1).Resize(n) = .Rows(i).Value 'copie les valeurs
            End If
        Next
    End With
End With
End Sub

A+

 

[EveDesLys]

Super, ça fonctionne parfaitement maintenant! Merci beaucoup!