Insertion de plusieurs lignes

alkacefa17

XLDnaute Nouveau
Bonjour,
Je parcours les forums pour trouver un code qui me permette d'inserer plusieurs lignes dans un tableaux et recopier les formats mais également les formules.
Actuellement j'insere une ligne mais sans les formules.

Quelqu'un peut il m'aider
Merci
 

Pièces jointes

  • Compte BancaireSauv.xlsm
    135.9 KB · Affichages: 42

vgendron

XLDnaute Barbatruc
bonjour

il faudrait quelques précisions
tu insères une ligne sans les formules dans un tableau
1) avec quel code
2) quelles formules ,
3) quel tableau?
4) et quelle feuille?
5) à quel moment ces lignes doivent elles etre insérées? automatiquement lorsque quelque chose se produit ? ou manuellmeent quand tu cliques sur un bouton?
 

vgendron

XLDnaute Barbatruc
avec ces trois lignes. ca devrait suffire pour recopier la dernière ligne avec formules..
VB:
derlig = Range("A" & Rows.Count).End(xlUp).Row + 2 'il vaut mieux partir du bas

Rows(derlig).Copy
Rows(derlig).Insert Shift:=xlShiftDown 'Insertion à la première ligne vide
Application.CutCopyMode = False
 

vgendron

XLDnaute Barbatruc
re
Je me suis permis de regarder le reste du code
si j'ai bien compris, tu souhaites inserer des lignes dans la feuille Compte pour que ta macro echeancier fonctionne correctement..
voir le code ci-dessous
VB:
Sub PrepaEcheancier()
'
' PrepaEcheancier Macro
Dim DligE As Long, Lig As Long
Dim Nextlig As Long
Dim NSht As String, VDate As Date, Délai As String
Dim ShtE As Worksheet
Dim NbLToInsert As Integer

Sheets("ECHEANCIER").Select

' Définir la feuille échéancier
Set ShtE = Sheets("ECHEANCIER")
' Récupéer la dernière ligne
DligE = ShtE.Range("C" & Rows.Count).End(xlUp).Row

Range("M2:M" & DligE).Copy Destination:=Range("L2") 'on recopie la colonne M en L

For Lig = 2 To DligE
    If ShtE.Range("L" & Lig).Value = "x" Then
        Délai = ShtE.Range("A" & Lig).Value
        NSht = ShtE.Range("B" & Lig).Value
        With Sheets(NSht)
            Nextlig = .Range("B" & Rows.Count).End(xlUp).Row
            'inserer une ligne ici !!
            .Rows(Nextlig).Copy
            .Rows(Nextlig).Insert Shift:=xlShiftDown
            Application.CutCopyMode = False
            .Range("A" & Nextlig + 1).Value = ShtE.Range("C" & Lig).Value
            .Range("E" & Nextlig + 1).Value = ShtE.Range("E" & Lig).Value
            .Range("F" & Nextlig + 1).Value = ShtE.Range("F" & Lig).Value
            .Range("B" & Nextlig + 1).Value = ShtE.Range("H" & Lig).Value
            .Range("C" & Nextlig + 1).Value = ShtE.Range("D" & Lig).Value
            If ShtE.Range("G" & Lig).Value <> "" Then 'ce test ne sert à rien !
                .Range("G" & Nextlig + 1).Value = ShtE.Range("G" & Lig).Value
            Else
                .Range("G" & Nextlig + 1).Value = ShtE.Range("G" & Lig).Value
            End If
        End With
        Select Case Délai
            Case "Tous les mois"
                VDate = ShtE.Range("C" & Lig).Value
                ShtE.Range("C" & Lig).Value = DateAdd("m", 1, VDate)
            Case "Tous les 3 mois"
                VDate = ShtE.Range("C" & Lig).Value
                ShtE.Range("C" & Lig).Value = DateAdd("m", 3, VDate)
            'Case "Autes jours du mois"
             ' VDate = ShtE.Range("C" & Lig).Value
              'ShtE.Range("C" & Lig).Value = DateAdd("m","d"; 1, VDate)
            'Case "Tous les ans"
              'VDate = ShtE.Range("C" & Lig).Value
              'ShtE.Range("C" & Lig).Value = DateAdd("y", 1, VDate)
        End Select
        ShtE.Range("L" & Lig).ClearContents
    End If
Next Lig


  ' RangeCompte Macro
    Sheets("Compte").Activate
   
    Range("A4:O" & Nextlig + 1).Select
    ActiveWorkbook.Worksheets("Compte").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Compte").Sort.SortFields.Add Key:=Range("A4"), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Compte").Sort
        .SetRange Range("A4:O" & Nextlig + 1)
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
  'première ligne vide
  Sheets("Compte").Select
  Range("A1").End(xlDown).Offset(1, 0).Select
End Sub
 

alkacefa17

XLDnaute Nouveau
Bonsoir,
Au depart je souhaitais une aide pour insérer plusieurs lignes "manuellement" avec format et formules
et si tu peux m'aider je suis preneur.
Ta proposition m' intéresse beaucoup je n'y avais pas pensé. Par contre quand je la lance :
- dans l'onglet "Échéancier" la macro efface la formule en colonne "G" et du coup au lancement suivant les montants sont à 0.

- dans l'onglet "Compte" la macro doit recopier l' échéancier à la suite des opérations car je ne trie pas par date l'onglet "Compte"

également la macro ne recalcule pas correctement le "Solde" en effet après la recopie de l'échéancier les soldes ne sont plus : K-1(cellule du dessus)+J-I(même ligne)
Je reste à ta disposition, et merci de padder du temps pour moi.
Cordialement
 

Pièces jointes

  • Compte BancaireSauv.xlsm
    141 KB · Affichages: 30

alkacefa17

XLDnaute Nouveau
1) avec quel code Code Inserstion Ligne
2) quelles formules , Formule en colonne I,J, K, M,N,O, P
3) quel tableau?
4) et quelle feuille? Onglet Compte
5) à quel moment ces lignes doivent elles etre insérées? automatiquement lorsque quelque chose se produit ? ou manuellmeent quand tu cliques sur un bouton? Manuellement en cliquant sur insertion Ligne " un Msg pour définir le nombre de lignes à inserer sous la denière ligne non vide (ici sous la L12)
Amicalment
 

Pièces jointes

  • Compte BancaireSauv.xlsm
    142.3 KB · Affichages: 30

vgendron

XLDnaute Barbatruc
Hello

il me semble que la macro de Dan que tu as déjà répond en partie au besoin
voir ci dessous pour la version modifiée
elle recopie les formules et la mise en forme
VB:
Sub Insererlignes()
'Macro Dan
Dim message As String, title As String
Dim nblg As Byte

derlig = Range("A4").End(xlDown).Row 'recherche dernière ligne NON vide

'Rows(derlig).Select
message = "Entrez le nombre de lignes"
title = "Insérer lignes"
nblg = Application.InputBox(message, title, Type:=1)
If nblg = 0 Then MsgBox "Le nombre de lignes est à zéro": End
Rows(derlig + 1).Resize(nblg, 1).EntireRow.Insert Shift:=xlDown
Range("D" & derlig).Resize(nblg + 1, 1).FillDown
Range("I" & derlig).Resize(nblg + 1, 3).FillDown
Range("M" & derlig).Resize(nblg + 1, 4).FillDown


   Rows(derlig).Copy
    Rows(derlig).Resize(nblg + 1).Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
   
End Sub
 

vgendron

XLDnaute Barbatruc
Ce code convient mieux je pense.. les formules des lignes "Total opérations et solde compte" se mettent à jour avec les nouvelles lignes insérées

VB:
Sub Insererlignes()
'déclaration des variables
Dim message As String, title As String
Dim nblg As Byte

derlig = Range("A" & Rows.Count).End(xlUp).Row 'il vaut mieux partir du bas pour trouver la dernière ligne NON vide

'on prépare les infos pour le message box
message = "Entrez le nombre de lignes"
title = "Insérer lignes"
'demande le nombre de lignes à insérer
nblg = Application.InputBox(message, title, Type:=1)
'test pour sortir au cas ou l'utilisateur rentre 0 ligne
If nblg = 0 Then MsgBox "Le nombre de lignes est à zéro": End

'copie de la dernière ligne remplie
Rows(derlig).Copy

Rows(derlig).Resize(nblg, 1).Insert Shift:=xlShiftDown 'Insertion par copie des nouvelles lignes
Rows(derlig + 1).Resize(nblg).ClearContents 'on efface le contenu des lignes copiées pour avoir des lignes vierges

'recopie des formules des différentes colonnes
Range("D" & derlig).Resize(nblg + 1, 1).FillDown
Range("I" & derlig).Resize(nblg + 1, 3).FillDown
Range("M" & derlig).Resize(nblg + 1, 4).FillDown

'copie de la mise en forme identique à la dernière ligne recopiée
Rows(derlig).Copy
Rows(derlig).Resize(nblg + 1).Select
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
   
End Sub
 

alkacefa17

XLDnaute Nouveau
Bonjour, je viens de tester la macro. L'insertion des lignes se fait bien , mais les soldes sont décalés par rapport aux lignes comme tu le verras sur la pièce jointe.
J'avais pensé, nommer la 1èere ligne de calcul (ex, Debut) et la dernière ligne du tableau (ex, Fin) et de recopier la formule entre ces 2 lignes. Je ne sais pas si çà peut être une solution

AMicalemnt
 

Pièces jointes

  • Compte BancaireSauv.xlsm
    140.2 KB · Affichages: 27

vgendron

XLDnaute Barbatruc
Hello

Je ne vois pas de quels soldes tu parles..
en plus.. ca fait déjà plusieurs fois que je "purge" tes modules vba vides (bon, en fait. je viens de voir que je ne t'avais jamais renvoyé ton fichier, juste la macro...)
par contre, là.. dans ton dernier fichier il y a DEUX macros Insertion2 ainsi que DEUX macro insererligne
ainsi que d'autres macro en doublon.. PAS BON du tout !

je me dis donc que ce n'est pas la bonne macro qui est lancée
Donc
voici ton fichier purgé (modules vides supprimés) ainsi que tout un tas de nom (gestionnaire de nom) avec des erreurs -->Supprimé !
avec LA macro qui fonctionne. (me semble t il) --> Après, si il y a toujours un souci, il faudrait que tu décrives précisement (en donnant les numéros de cellules) ce qui ne va pas
 

Pièces jointes

  • Compte BancaireSauv Rev2.xlsm
    132.2 KB · Affichages: 40

alkacefa17

XLDnaute Nouveau
Bonjour, Merci d'avoir pris du temps pour solutionner mon problème.
Tes differentes interventions m'ont permis d'avancer, et de mon côté j'ai continué de chercher et ce matin voilà ce ce que j'ai enfin réussi à finaliser.
Sub Insererlignes()

Dim message As String, title As String
Dim nblg As Byte
Dim Debut As String
Dim fin As String
Dim Solde As String

derlig = Range("A4").End(xlDown).Row 'recherche dernière ligne NON vide

'Rows(derlig).Select
message = "Entrez le nombre de lignes"
title = "Insérer lignes"
nblg = Application.InputBox(message, title, Type:=1)
If nblg = 0 Then MsgBox "Le nombre de lignes est à zéro": End
Rows(derlig + 1).Resize(nblg, 1).EntireRow.Insert Shift:=xlDown
Range("D" & derlig).Resize(nblg + 1, 1).FillDown
Range("I" & derlig).Resize(nblg + 1, 3).FillDown
Range("M" & derlig).Resize(nblg + 1, 4).FillDown


Rows(derlig).Copy
Rows(derlig).Resize(nblg + 1).Select
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False


Range("Debut").Select
Selection.AutoFill Destination:=Range("Debut:Fin"), Type:=xlFillDefault
Range("Debut:Fin").Select
Range("Solde").Select

End Sub

Je te remercie encore pour ton aide
Cordialement
 

Discussions similaires

Statistiques des forums

Discussions
311 720
Messages
2 081 886
Membres
101 830
dernier inscrit
sonia poulaert