Macro Insertion de ligne à endroit déterminé

Sylvie

XLDnaute Accro
Bonjour à tous,

Je fais de nouveau appel à vos services pour parvenir à automatiser l'intégration de journaux excel dans des logiciels de comptabilité.
J'ai bien trouvé certains sujets traitant de l'insertion de lignes mais faute de connaissances suffisantes, je ne parviens pas à modifier le code pour coller à mon besoin.

Dans un journal d'achat ou de vente, je souhaite pourvoir à l'aide d'une macro insérer 2 lignes après une ligne dont la position dans l'idéal pourrait être choisie via un message et compléter ces deux lignes par la TVA autoliquidée propre aux achats ou ventes intracommunautaires :

L'ideal serait donc le process suivant :
1° Après quelles lignes faut il rajouter de la TVA intracomm ? (exemple on choisit ligne 9 )
2- Insertion de 2 lignes en dessous (donc création de lignes 10 et 11) puis :
copie de la ligne du dessus (9) pour les colonnes A à D et G (ceci sur les 2 lignes 10 et 11 créées et insérées par macro)
Pour la ligne 10 la Colonne E serait remplie avec '445662" (c'est le compte comptable) et la colonne H (débit) serait automatiquement remplie par une formule =20 % de H9
Pour la ligne 11 la colonne E serait remplie avec "445712" et la colonne I (crédit) serait remplie avec le même montant que celui calculé en H10

Je vous joins un fichier avec l'onglet de départ et l'onglet d'arrivé souhaité (j'ai mis les lignes que je souhaite créer et insérer en vert)


Merci par avance pour votre aide qui je le sais me fera gagner beaucoup de temps.

Sylvie
 

Pièces jointes

  • Journla achat intracomm.xlsx
    24.1 KB · Affichages: 32

JCGL

XLDnaute Barbatruc
Bonjour à tous,
Salut Sylvie,

Peux-tu essayer avec ceci dans un module :

VB:
Option Explicit

Sub Test()
    Dim Lig&
    Lig = InputBox("Choisir la ligne SOUS laquelle seront insérées 2 lignes comptables", "Choix", 9)
    With Feuil5
        Range("A" & Lig + 1).EntireRow.Insert
        Range("A" & Lig + 1).EntireRow.Insert
        Range("A" & Lig - 1 & ":D" & Lig).Copy Range("A" & Lig + 1)
        Range("G" & Lig - 1 & ":G" & Lig).Copy Range("G" & Lig + 1)
        Range("H" & Lig + 1) = Range("H" & Lig) * (20 / 100)
        Range("I" & Lig + 2) = Range("H" & Lig + 1)
        Range("E" & Lig + 1) = 445662
        Range("E" & Lig + 2) = 445712
        Range("A" & Lig + 1 & ":I" & Lig + 2).Interior.ThemeColor = xlThemeColorAccent3
        Range("E2").Select
    End With
End Sub

A+ à tous
 
Dernière édition:

Sylvie

XLDnaute Accro
Bonjour JCGL,

Tout d'abord, je te remercie infiniment pour ta contribution (une de plus) qui va vraiment me faire gagner du temps là où on procédait à la mano.
Ça fonctionne impeccablement.
Juste une précision : comment dois je modifier le code pour préciser que je veux un arrondi à deux décimales de ma TVA calculée ? (je n'avais pas pensé à cela dans mon post de départ)

Sylvie
 

JCGL

XLDnaute Barbatruc
Bonjour à tous,

Prends cette ligne :
VB:
 Range("H" & Lig + 1) = WorksheetFunction.Round(Range("H" & Lig) * (20 / 100), 2)

A+ à tous

Edition : fichier avec l'arrondi de TVA
 

Pièces jointes

  • JC 3 Journal Achat Intracomxlsm.xlsm
    35.4 KB · Affichages: 32
Dernière édition:

JCGL

XLDnaute Barbatruc
Bonjour à tous,

Avec ceci :
VB:
Option Explicit

Sub Test()
    Dim Lig&, DerL&
    DerL = Feuil5.Range("A" & Rows.Count).End(xlUp).Row*2
    For Lig = 5 To DerL
        If Cells(Lig, 11) = "X" Then
            With Feuil5
                Range("A" & Lig + 1).EntireRow.Insert
                Range("A" & Lig + 1).EntireRow.Insert
                Range("A" & Lig - 1 & ":D" & Lig).Copy Range("A" & Lig + 1)
                Range("G" & Lig - 1 & ":G" & Lig).Copy Range("G" & Lig + 1)
                Range("H" & Lig + 1) = WorksheetFunction.Round(Range("H" & Lig) * (20 / 100), 2)
                Range("I" & Lig + 2) = Range("H" & Lig + 1)
                Range("E" & Lig + 1) = 445662
                Range("E" & Lig + 2) = 445712
                Range("A" & Lig + 1 & ":I" & Lig + 2).Interior.ThemeColor = xlThemeColorAccent3
                Range("E2").Select
            End With
        End If
    Next Lig
End Sub

A+ à tous
 
Dernière édition:

David

XLDnaute Occasionnel
Avec + 5 chez moi ça marche.

VB:
Option Explicit
Sub Test()
    Dim Lig&, DerL&
    DerL = Feuil5.Range("A" & Rows.Count).End(xlUp).Row
    For Lig = 5 To DerL + 5
        If Cells(Lig, 11) = "X" Then
            With Feuil5
                Range("A" & Lig + 1).EntireRow.Insert
                Range("A" & Lig + 1).EntireRow.Insert
                Range("A" & Lig - 1 & ":D" & Lig).Copy Range("A" & Lig + 1)
                Range("G" & Lig - 1 & ":G" & Lig).Copy Range("G" & Lig + 1)
                Range("H" & Lig + 1) = WorksheetFunction.Round(Range("H" & Lig) * (20 / 100), 2)
                Range("I" & Lig + 2) = Range("H" & Lig + 1)
                Range("E" & Lig + 1) = 445662
                Range("E" & Lig + 2) = 445712
                Range("A" & Lig + 1 & ":I" & Lig + 2).Interior.ThemeColor = xlThemeColorAccent3
                Range("E2").Select
            End With
            DerL = DerL + 2
        End If
    Next Lig
End Sub

@+
 

Sylvie

XLDnaute Accro
Bonsoir à tous

Ah quel immense plaisir de te revoir Jean Marie ! ..... Que de souvenirs n'est ce pas ... ?

Merci beaucoup JCGL et David : vous me tirez une belle épine du pied ... VBA reste un graal pour moi et ceux qui le manient aussi bien que vous, des Héros :)

Bonne soirée et bises spéciales pour toi Jean Marie et pour tous ceux que j'ai connu

Sylvie
 

Discussions similaires