Macro ajouter des lignes à différents endroits
Bonjour tout le monde,
J'ai créé cette macro (ci-jointe) a partir de mes codes déjà existant et de l'aide à gauche et à droite (je débute donc j'essaye de comprendre ce que je trouve et de le comprendre).
Pour cette macro, le principe est de pouvoir ajouter des lignes à différents endroits sur le classeur.
Dans mon exemple, je veux ajouter 2 lignes sur "Feuil1" et 2 lignes sur "Feuil2" à des endroits défini par un Range (gestionnaire de nom).
la macro marche plutôt bien mais le problème arrive quand deux cellule se nomme pareil (avec un nom gestionnaire de nom différents).
Mon fichier sera plus explicite,
Je vous remercie de votre aide,
Cordialement,
PS, voici le code :
Sub Macro2()
Dim i As Integer, j As Integer, NbLigne As Integer, DerLigne As Integer, Ligne As Integer
'Application.ScreenUpdating = False
NbLigne = InputBox(Prompt:="Nombre de lignes à inserer ? ATTENTION, Il NE DOIT PAS Y AVOIR DE LIGNE AVEC DES ERREURS", Title:="Insertion de lignes", _
Default:=1)
If IsNumeric(NbLigne) And NbLigne > 0 Then 'Verifie que la valeur entrée est un nombre superieur à 0
With Sheets("Compte de résultat")
.Activate
DerLigne = .Range("B" & Rows.Count).End(xlUp).Row
For i = 1 To DerLigne
If .Cells(i, 2) = Range("ZZZZZ") Then
Ligne = i - 1: Exit For
End If
Next i
For i = Ligne To NbLigne + Ligne - 1
.Rows(i).Insert Shift:=xlDown
.Cells(i - 1, 2).Copy .Cells(i, 2): .Cells(i, 2).Value = .Cells(i, 2) + 1
.Cells(i - 1, 6).Copy .Cells(i, 6)
.Cells(i - 1, 8).Copy .Cells(i, 8)
.Cells(i - 1, 9).Copy .Cells(i, 9)
.Cells(i - 1, 10).Copy .Cells(i, 10)
.Cells(i - 1, 11).Copy .Cells(i, 11)
Next i
End With
With Sheets("Compte de résultat")
.Activate
DerLigne = .Range("B" & Rows.Count).End(xlUp).Row
For i = 1 To DerLigne
If .Cells(i, 2) = Range("ZZZZZ1") Then
Ligne = i - 1: Exit For
End If
Next i
For i = Ligne To NbLigne + Ligne - 1
.Rows(i).Insert Shift:=xlDown
.Cells(i - 1, 2).Copy .Cells(i, 2)
.Cells(i - 1, 6).Copy .Cells(i, 6)
.Cells(i - 1, 8).Copy .Cells(i, 8)
.Cells(i - 1, 9).Copy .Cells(i, 9)
.Cells(i - 1, 10).Copy .Cells(i, 10)
Next i
End With
With Sheets("Trésorerie")
.Activate
DerLigne = .Range("B" & Rows.Count).End(xlUp).Row
For i = 1 To DerLigne
If .Cells(i, 2) = Range("XXXXX") Then
Ligne = i - 1: Exit For
End If
Next i
For i = Ligne To NbLigne + Ligne - 1
.Rows(i).Insert Shift:=xlDown
.Cells(i - 1, 2).Copy .Cells(i, 2)
.Cells(i - 1, 3).Copy .Cells(i, 3)
.Cells(i - 1, 4).Copy .Cells(i, 4)
.Cells(i - 1, 5).Copy .Cells(i, 5)
Next i
End With
With Sheets("Trésorerie")
.Activate
DerLigne = .Range("B" & Rows.Count).End(xlUp).Row
For i = 1 To DerLigne
If .Cells(i, 2) = Range("XXXXX1") Then
Ligne = i - 1: Exit For
End If
Next i
For i = Ligne To NbLigne + Ligne - 1
.Rows(i).Insert Shift:=xlDown
.Cells(i - 1, 2).Copy .Cells(i, 2)
.Cells(i - 1, 3).Copy .Cells(i, 3)
.Cells(i - 1, 4).Copy .Cells(i, 4)
.Cells(i - 1, 5).Copy .Cells(i, 5)
Next i
End With
With Sheets("Compte de résultat")
.Activate
End With
Else
MsgBox "Le nombre de lignes à insérer doit être supérieur à 0." & Chr(10) & "Veuillez recommencer."
End If
End Sub
Bonjour
Si j'ai bien compris ta demande, modifie déjà la première partie du code comme suit
Sub Macro2()
Dim i As Integer, j As Integer, NbLigne As Integer, DerLigne As Integer, Ligne As Integer
'Application.ScreenUpdating = False
On Error Resume Next
NbLigne = InputBox(Prompt:="Nombre de lignes à inserer ? ATTENTION, Il NE DOIT PAS Y AVOIR DE LIGNE AVEC DES ERREURS", Title:="Insertion de lignes", _
Default:=1)
If Err > 0 Then Exit Sub
On Error GoTo 0
If IsNumeric(NbLigne) And NbLigne > 0 Then 'Verifie que la valeur entrée est un nombre superieur à 0
With Sheets("Compte de résultat")
.Activate
DerLigne = .Range("B" & .Rows.Count).End(xlUp).Row
For i = 1 To DerLigne
If .Cells(i, 2) = Range("ZZZZZ") Then
Ligne = i - 1: Exit For
End If
Next i
For i = Ligne To NbLigne + Ligne - 1
.Rows(i).Insert Shift:=xlDown
.Cells(i - 1, 2).Copy .Cells(i, 2): .Cells(i, 2).Value = .Cells(i, 2) + 1
.Cells(i - 1, 6).Copy .Cells(i, 6)
.Cells(i - 1, 8).Copy .Cells(i, 8)
.Cells(i - 1, 9).Copy .Cells(i, 9)
.Cells(i - 1, 10).Copy .Cells(i, 10)
.Cells(i - 1, 11).Copy .Cells(i, 11)
Next i
DerLigne = .Range("B" & .Rows.Count).End(xlUp).Row
For i = i + 2 To DerLigne
If .Cells(i, 2) = Range("ZZZZZ1") Then
Ligne = i - 1: Exit For
End If
Next i
For i = Ligne To NbLigne + Ligne - 1
.Rows(i).Insert Shift:=xlDown
.Cells(i - 1, 2).Copy .Cells(i, 2)
.Cells(i - 1, 6).Copy .Cells(i, 6)
.Cells(i - 1, 8).Copy .Cells(i, 8)
.Cells(i - 1, 9).Copy .Cells(i, 9)
.Cells(i - 1, 10).Copy .Cells(i, 10)
Next i
End With
.....J'ai supprimé quelques instructions pour simplifier.
Le "On error..." évite le plantage lorsque tu cliques sur le bouton "Annuler"
A ta relire sur la proposition avant d'aller plus loin
crdlt
Bonjour et merci de votre réponse,
Ça a l'air parfait !!!
si je comprend bien, c'est la ligne :
For i = 1 To DerLigne
en la mettant comme cela :
For i = i + 2 To DerLigne
est ce que cela permet de "sauter" la première occurrence que rencontre la macro ? ainsi si je veux rajouter des zones je fait i+3 etc..?
J'essaye de comprendre en même temps !
j'attend votre retour et je met en résolu!
Bien cordialement,
Re bonjour,
J'ai peut être crié victoire un peu trop vite,
J'ai testé d'autres scénario dans mon fichier et j'ai créé une nouvelle zone (trois zones).
J'ai ajouté les lignes de codes correspondantes et quand j'active la macro j'ai bien les lignes qui sont ajoutées sur les trois zones.
Le hic c'est si je veux maintenant ajouter des lignes uniquement dans la zone 1 et 3 (et pas dans la 2) cela ne marche pas et les lignes sont ajoutées dans les zones 1 et 2.
Et je ne comprend pas pourquoi le range n'est pas pris en compte...
Le fichier ci joint est plus explicite,
Bien cordialement[*],
Re
Le hic c'est si je veux maintenant ajouter des lignes uniquement dans la zone 1 et 3 (et pas dans la 2) cela ne marche pas et les lignes sont ajoutées dans les zones 1 et 2.
Et je ne comprend pas pourquoi le range n'est pas pris en compte...
Quel est le critère de choix d'ajouter en ligne 1 et 3 ou j'imagine dans 2 et 3 ? Là il faut que le code le sache
Donne moi quelque détails sur le choix que tu veux faire et surtout si le tableau peut avoir une zone supplémentaire
A te relire
Bonjour,
je vais essayer d'être le plus clair possible.
Pour commencer :
"Quel est le critère de choix d'ajouter en ligne 1 et 3 ou j'imagine dans 2 et 3 ?"
> C'est bien la mon problème, Le texte de de chaque cellule des zones est "TOTAL", on ne peut donc pas utiliser ce critère.
Etant donnée que des lignes sont ajoutées/ ou supprimé on ne peut donc pas utiliser les référence absolue ou relatives. J'ai donc pensé utiliser le gestionnaire de nom, ou, les différentes cellules "TOTAL" serai nommées différemment (mais j'ai l'impression que sur la macro cela n'est pas prit en compte).
Dans mon fichier exemple, le premier "TOTAL se nomme "TOTAL11", le deuxième "ZZZZZ1" et le troisième "ZZZZZ2".
Je souhaite donc (car je pense que c'est la solution la plus adéquate) que la macro détecte dans la colonne B le RANGE "Nom du Range" et ajoute, deux lignes au dessus, les lignes indiqués (tout en conservant comme c'est le cas, les formules des lignes du dessus).
Je pense que c'est l'utilisation de "DerLigne" qui n'est pas judicieux mais je suis pas sur.
"surtout si le tableau peut avoir une zone supplémentaire"
> Oui il pourra y avoir d'autres zones supplémentaires mais qui ne peuvent pas être défini pour l'instant.
l'idée est que lorsque des lignes doivent être ajoutées a d'autres "zones" je copie/colle les lignes de la macro et que je l'adapte au nouveaux critères.
Dans l’hypothèse ou j'ai une zones 4 qui doit avoir des lignes qui s'ajoute également, j’appellerai la cellule "TOTAL" "ZZZZZ3" et j'ajouterai manuellement les blocs de lignes de code en changeant juste le Range.
Je vous remercie beaucoup de continuer à m'aider,
Bien cordialement,
re,
ton souci est que le nom défini correspond au mot TOTAL qui est identique dans les trois tableaux. Lors de la boucle le mot Total est vu comme tel. En gros si veux ajouter une ligne dans le troisième tableau et que ton code par le mot TOTAL dans le deuxième tableau, le code ajoutera la ligne dans le deuxième tableau au lieu du troisième
Essaie en modifiant le code :
Sub Macro2()
Dim i As Integer, j As Integer, NbLigne As Integer, Ligne As Integer
'Application.ScreenUpdating = False
On Error Resume Next
NbLigne = InputBox(Prompt:="Nombre de lignes à inserer ? ATTENTION, Il NE DOIT PAS Y AVOIR DE LIGNE AVEC DES ERREURS", Title:="Insertion de lignes", _
Default:=1)
If Err > 0 Then Exit Sub
On Error GoTo 0
If IsNumeric(NbLigne) And NbLigne > 0 Then 'Verifie que la valeur entrée est un nombre superieur à 0
With Sheets("Compte de résultat")
.Activate
For i = 1 To Range("TOTAL11").Row
If .Cells(i, 2) = Range("TOTAL11") Then
Ligne = i - 1: Exit For
End If
Next i
For i = Ligne To NbLigne + Ligne - 1
.Rows(i).Insert Shift:=xlDown
.Cells(i - 1, 2).Copy .Cells(i, 2)
.Cells(i - 1, 6).Copy .Cells(i, 6)
.Cells(i - 1, 8).Copy .Cells(i, 8)
.Cells(i - 1, 9).Copy .Cells(i, 9)
.Cells(i - 1, 10).Copy .Cells(i, 10)
.Cells(i - 1, 11).Copy .Cells(i, 11)
Next i
For i = (Range("ZZZZZ1").Row + 1) To Range("ZZZZZ2").Row
If .Cells(i, 2) = Range("ZZZZZ2") Then
Ligne = i - 1: Exit For
End If
Next i
For i = Ligne To NbLigne + Ligne - 1
.Rows(i).Insert Shift:=xlDown
.Cells(i - 1, 2).Copy .Cells(i, 2)
.Cells(i - 1, 6).Copy .Cells(i, 6)
.Cells(i - 1, 8).Copy .Cells(i, 8)
.Cells(i - 1, 9).Copy .Cells(i, 9)
.Cells(i - 1, 10).Copy .Cells(i, 10)
Next i
End With
.....J'ai juste modifié la première partie mais la deuxième suit la même phylosophie
A te relire
Bonjour,
J'ai testé et ça fonctionne !!!!
Donc déjà un grand merci !
J'ai testé différents scénario et dans l’hypothèse ou il y a plusieurs zone a sauter j'ai du faire un "bricolage" de ce type :
Next i
For i = (Range("MARCHB2").Row + 1) To Range("TVACOLL").Row
Next i
For i = (Range("TVACOLL").Row + 1) To Range("PRODB3").Row
Next i
For i = (Range("PRODB3").Row + 1) To Range("MARCHB3").Row
If .Cells(i, 2) = Range("MARCHB3") Then
Ligne = i - 1: Exit For
End If
Sinon pour ma compréhension personnelle je comprend que la boucle rencontre à chaque fois le mot total, mais pourquoi il ne vas pas directement sur le Range?
Je laisse la macro ci dessous, la deuxième partie "TRÉSORERIE" reprend la même trame.
Je suis ouvert a toutes propositions
Bien Cordialement,
Sub AjLigne1()
Dim i As Integer, j As Integer, NbLigne As Integer, Ligne As Integer
'Application.ScreenUpdating = False
On Error Resume Next
NbLigne = InputBox(Prompt:="Nombre de lignes à inserer ? ATTENTION, Il NE DOIT PAS Y AVOIR DE LIGNE AVEC DES ERREURS", Title:="Insertion de lignes", _
Default:=1)
If Err > 0 Then Exit Sub
On Error GoTo 0
If IsNumeric(NbLigne) And NbLigne > 0 Then 'Verifie que la valeur entrée est un nombre superieur à 0
With Sheets("Compte de résultat")
.Activate
For i = (Range("PROD1").Row + 1) To Range("MARCH1").Row
If .Cells(i, 2) = Range("MARCH1") Then
Ligne = i - 1: Exit For
End If
Next i
For i = Ligne To NbLigne + Ligne - 1
.Rows(i).Insert Shift:=xlDown
.Cells(i - 1, 2).Copy .Cells(i, 2)
.Cells(i - 1, 6).Copy .Cells(i, 6)
.Cells(i - 1, 8).Copy .Cells(i, 8)
.Cells(i - 1, 9).Copy .Cells(i, 9)
.Cells(i - 1, 10).Copy .Cells(i, 10)
.Cells(i - 1, 11).Copy .Cells(i, 11)
Next i
For i = (Range("MARCH1").Row + 1) To Range("AMARCH1").Row
If .Cells(i, 2) = Range("AMARCH1") Then
Ligne = i - 1: Exit For
End If
Next i
For i = Ligne To NbLigne + Ligne - 1
.Rows(i).Insert Shift:=xlDown
.Cells(i - 1, 2).Copy .Cells(i, 2)
.Cells(i - 1, 6).Copy .Cells(i, 6)
.Cells(i - 1, 8).Copy .Cells(i, 8)
.Cells(i - 1, 9).Copy .Cells(i, 9)
.Cells(i - 1, 10).Copy .Cells(i, 10)
Next i
For i = (Range("AMARCH1").Row + 1) To Range("BMARCH1").Row
If .Cells(i, 2) = Range("BMARCH1") Then
Ligne = i - 1: Exit For
End If
Next i
For i = Ligne To NbLigne + Ligne - 1
.Rows(i).Insert Shift:=xlDown
.Cells(i - 1, 2).Copy .Cells(i, 2)
.Cells(i - 1, 6).Copy .Cells(i, 6)
.Cells(i - 1, 8).Copy .Cells(i, 8)
.Cells(i - 1, 9).Copy .Cells(i, 9)
.Cells(i - 1, 10).Copy .Cells(i, 10)
Next i
End With
With Sheets("Trésorerie")
Re
Sinon pour ma compréhension personnelle je comprend que la boucle rencontre à chaque fois le mot total, mais pourquoi il ne vas pas directement sur le Range?
Parce que le code et l'instruction RANGE(xxXX) renvoie le contenu à cet endroit et non pas l'adresse de la cellule. Donc dans ta boucle i dès que le code voit le mot "Total", impossible qu'il sache que ce mot est sur la ligne correct.
D'où l'idée de profiter du nom Range("PROD1") que tu as défini pour récupérer dans la boucle la ligne où il se trouve et via --> Range("PROD1").Row + 1.
Le +1 permet de commencer la boucle à partir de la ligne suivante et évite de commencer sur le mot Total correspond au contenu de Range("PROD1"). Sans ce +1 et via le IF tu sortirais de la boucle directement par le Exit for
Espérant que tu comprends
Si ok, oublie pas de cloturer le fil.
Veille aussi à utiliser les balises de code lorsque tu postes un code
Crdlt
D'accord,
Je crois que je comprend,
Merci encore!