Microsoft 365 Insérer 2 lignes en copiant certaines cellules

Mnd · 5 Novembre 2020

Bonjour à tous,

J'utilise une macro pour insérer 2 lignes après chaque ligne de mon tableau EXCEL

Sub InsertionLigne()
Dim i As Integer
For i = 100 To 1 Step -1
Cells(i + 1, 1).Select
ActiveCell.Offset(1).Resize(2, 1).EntireRow.Insert
Next
End Sub
Ce code fonctionne très bien mais j'aimerais ajouter des éléments.

J'aimerais que dans les cellules insérées des informations soient reprises
Les colonnes A B C et E doivent être copiées dans les 2 lignes insérées.
Dans la 2e ligne insérée colonne D j'aimerais le code 445660 systématiquement
Dans la 1ère ligne insérée colonne F j'aimerais que montant indiqué dans la colonne G de la ligne juste au-dessus soit divisé par 1.2
Dans la 2e ligne insérée colonne F j'aimerais que montant indiqué soit le montant de la colonne G 2 lignes au dessus - le montant de la colonne F 1 ligne au-dessus :
Exemple ci-dessous :

Journal	Date	Réf. pièce	Compte	Libellé	Débit	Crédit
AC	01/06/2020	SOLEIL	467300	ABCD		405,00
AC	01/06/2020	SOLEIL		ABCD	337.50
AC	01/06/2020	SOLEIL	445660	ABCD	67.50

Pourriez-vous m'aider s'il vous plait ?

Merci à vous d'avance !

Rouge · 6 Novembre 2020

Bonjour,

Autre proposition, une fois que le traitement à été fait, les lignes traitées sont marquées "Traitées" en colonne H pour éviter de répéter l'opération sur ces lignes si le traitement à déjà eu lieu.

VB:

Sub InsertionLigne()
    Dim i As Long, DerLig As Long
    Application.ScreenUpdating = False
    DerLig = Range("A" & Rows.Count).End(xlUp).Row
    For i = DerLig To 2 Step -1
        If Range("H" & i).Value = "" Then 'si la ligne n'est pas encore traitée
            'on insère 2 lignes et on recopie la ligne en cours
            Range("A" & i & ":H" & i).Copy
            Range("A" & i + 1 & ":H" & i + 2).Insert Shift:=xlDown
            Range("D" & i + 1 & ":H" & i + 2).ClearContents 'on efface les données en surplus...

haonv · 6 Novembre 2020

Bonjour,

Un essai avec

Sub InsertionLigne()
Dim i As Integer

For i = 100 To 1 Step -1
Cells(i + 1, 1).Offset(1).Resize(2, 1).EntireRow.Insert
Range("A1:E1").Offset(i + 1).Value = Range("A1:E1").Offset(i).Value ''''on colle les valeurs des colonnes A et D sur les 2 lignes insérées
Range("A1:E1").Offset(i + 2).Value = Range("A1:E1").Offset(i).Value
Cells(i + 2, 4) = "" '''on efface la colonne D de la première ligne insérée
Cells(i + 3, 4) = 445660 'on entre la donnée en colonne D de la deuxième ligne insérée
Cells(i + 2, 6) = Round(Cells(i + 1, 7) / 1.2, 2) ''' on calcule le prix divisé par 1,2 en F sur la première ligne insérée.(Arrondi à 2 chiffres apres la virgule)
Cells(i + 3, 6) = Cells(i + 1, 7) - Cells(i + 2, 6) ''' on calcule le prix en F sur la deuxième ligne insérée
Next

End Sub

Cordialement

Rouge · 6 Novembre 2020

Bonjour,

Autre proposition, une fois que le traitement à été fait, les lignes traitées sont marquées "Traitées" en colonne H pour éviter de répéter l'opération sur ces lignes si le traitement à déjà eu lieu.

VB:

Sub InsertionLigne()
    Dim i As Long, DerLig As Long
    Application.ScreenUpdating = False
    DerLig = Range("A" & Rows.Count).End(xlUp).Row
    For i = DerLig To 2 Step -1
        If Range("H" & i).Value = "" Then 'si la ligne n'est pas encore traitée
            'on insère 2 lignes et on recopie la ligne en cours
            Range("A" & i & ":H" & i).Copy
            Range("A" & i + 1 & ":H" & i + 2).Insert Shift:=xlDown
            Range("D" & i + 1 & ":H" & i + 2).ClearContents 'on efface les données en surplus
            
            'Dans la 2e ligne insérée colonne D j'aimerais le code 445660 systématiquement
            Cells(i + 2, "D") = 445660
            
            'Dans la 1ère ligne insérée colonne F j'aimerais que montant indiqué dans la colonne G de la ligne juste au-dessus soit divisé par 1.2
            Cells(i + 1, "F") = Cells(i, "G") / 1.2
            
            'Dans la 2e ligne insérée colonne F j'aimerais que montant indiqué soit le montant de la colonne G 2 lignes au dessus - le montant de la colonne F 1 ligne au-dessus
            Cells(i + 2, "F") = Cells(i, "G") - Cells(i + 1, "F")
            Range("H" & i & ":H" & i + 2).Value = "Traitée" 'on marque la ligne comme étant traitée pour éviter de répéter l'opération sur ces lignes
        End If
    Next
End Sub

Cdlt

Mnd · 6 Novembre 2020

Haonv et Rouge merci 1000 fois ! Vous venez de sauvez des jours et jours de saisies...
Merci infiniment !

haonv · 6 Novembre 2020

Re Mnd, Rouge,

Je reviens sur :
Cells(i + 2, 6) = Round(Cells(i + 1, 7) / 1.2, 2)
Je pense qu'il faut prendre l'arrondi à 2 chiffres comme c'est du monétaire, quelque soit le code choisi.
Suivant le format et les valeurs en colonne F et G, il y a un risque d'approximation pour certaines lignes.

Cordialement

Microsoft 365 Insérer 2 lignes en copiant certaines cellules

Mnd

XLDnaute Nouveau

Rouge

haonv

XLDnaute Occasionnel

Rouge

XLDnaute Impliqué

Pièces jointes

Mnd

XLDnaute Nouveau

haonv

XLDnaute Occasionnel

Discussions similaires