Faire une macro avec une boucle et un InputBox

Gudo · 8 Juin 2016

Bonjour à tout le Forum

J’ai une macro qui me permet d’insérer des lignes dans un tableau et qui recopie également des cellules qui sont situées sur la même ligne mais hors du tableau.

Code:

Sub Ligne_Insertion()

' Intertion de ligne

    ActiveCell.Rows("1:1").EntireRow.Select
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    [dernièreligneTotale].Copy Cells(ActiveCell.Row, 2).Resize(Selection.Rows.Count, 15)
    
End Sub

La macro fonctionne parfaitement.
Mais si je veux insérer 10 lignes, il me faut actionner la macro 10 fois !

Je ne connais pas bien les boucles, Je suppose qu’une macro avec un InputBox pour rentrer le nombre désiré d’insertions souhaitées et une boucle pour renouveler le code d’insertion ferait l’affaire.

Peut-être que quelqu’un à réaliser ce genre de macro ?

Merci d’avance

vgendron · 8 Juin 2016

Re : Faire une macro avec une boucle et un InputBox

Hello

Code:

Sub Ligne_Insertion()
'pour demander le nombre de boucles
nb = CInt(InputBox("donnez le nombre de boucles"))
'puis la boucle
for i = 1 to nb
' Intertion de ligne

    ActiveCell.Rows("1:1").EntireRow.Select
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    [dernièreligneTotale].Copy Cells(ActiveCell.Row, 2).Resize(Selection.Rows.Count, 15)
next i
end sub

Gudo · 8 Juin 2016

Re : Faire une macro avec une boucle et un InputBox

Bonjour Vgendron

C'est exactement ce que je voulais
Merci

Par contre c'est très lent, tout le fichier se recalcule entre chaque insertion
Il faudrait pouvoir bloquer ce recalcule pendant l'exécution de la macro si c'est possible ?

A+

vgendron · 8 Juin 2016

Re : Faire une macro avec une boucle et un InputBox

re

en plaçant cette ligne en début de code
ActiveSheet.EnableCalculation = False

et celle ci en fin de code
ActiveSheet.EnableCalculation = true

youky(BJ) · 8 Juin 2016

Re : Faire une macro avec une boucle et un InputBox

Bonjour tous,
A tester sans boucle
Bruno

Code:

Rows("1:10").Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    [dernièreligneTotale].Copy Cells(ActiveCell.Row, 2).Resize(Selection.Rows.Count, 15)

Gudo · 8 Juin 2016

Re : Faire une macro avec une boucle et un InputBox

Bonsoir Vgendron

En attendant, j'ai cherché par moi-même et j'ai utilisé ce code :

Code:

Application.ScreenUpdating

Cela fonctionne, mais peut-être que le tien est plus approprié ??

J'ai également utilisé "Application.InputBox" au lieu de "nputBox"
Car j'avais une erreur si je cliquais sur "Annuler"

Je remets ma macro que j'ai modifiée

Cela fonctionne parfaitement
Mais je n'ai pas ton niveau, j'attends ton avis

Code:

Sub Insertion_Ligne_Nbr()

Dim Nb As Single

'pour demander le nombre de boucles
    Nb = CInt(Application.InputBox("Nombre d'insertion souhaitées ?", "Insertion de lignes", 1, Type:=1))
       'Intercepte l'utilisation du bouton "Annuler" et la croix de fermeture.
       If Nb = 0 Then Exit Sub
    
Application.ScreenUpdating = False 'Pour bloquer le calcul

'puis la boucle
For i = 1 To Nb

'Insertion de ligne
    ActiveCell.Rows("1:1").EntireRow.Select
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    [dernièreligneTotale].Copy Cells(ActiveCell.Row, 2).Resize(Selection.Rows.Count, 15)
Next i

Application.ScreenUpdating = True 'Pour réactiver le calcul automatique


End Sub

A+

Bonsoir Youky

Merci pour ta macro
Je m'absente et je teste ta macro

A+

vgendron · 9 Juin 2016

Re : Faire une macro avec une boucle et un InputBox

Hello all

En mixant avec la solution de Youky, pas besoin de boucle donc sans doute plus rapide
à tester sur ton fichier

Code:

Sub Insertion_Ligne_Nbr()

Dim Nb As Single

'pour demander le nombre de boucles
    Nb = CInt(Application.InputBox("Nombre d'insertion souhaitées ?", "Insertion de lignes", 1, Type:=1))
       'Intercepte l'utilisation du bouton "Annuler" et la croix de fermeture.
       If Nb = 0 Then Exit Sub
    
Application.ScreenUpdating = False 'Pour bloquer le calcul


'Insertion de ligne
    ActiveCell.Rows("1:" &nb).EntireRow.Select
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    [dernièreligneTotale].Copy Cells(ActiveCell.Row, 2).Resize(Selection.Rows.Count, 15)

Application.ScreenUpdating = True 'Pour réactiver le calcul automatique

End Sub

Gudo · 10 Juin 2016

Re : Faire une macro avec une boucle et un InputBox

Bonjour Vgendron, Youky, Le Forum

Je n'avais pas bien compris le code ans boucle, car il ne s'agissait que d'une copie sur 10 lignes ?
Ce nouveau code, permet bien de choisir le nombre de lignes souhaitées tout en conservant ce mode sans boucle !

Je l'ai essayé, mais il y a un problème
Si le nombre d'insertion est bonne, la recopie ne se fait que sur la 1ère ligne insérées !

Personnellement, je ne vois pas où se trouve le problème ??

A+

vgendron · 10 Juin 2016

Re : Faire une macro avec une boucle et un InputBox

Hello

l'ennui que l'on a depuis le début, c'est que nous, on travaille à l'aveugle:
il faudrait que tu postes ton fichier exemple - quelques lignes sans data confidentielles suffisent

Gudo · 10 Juin 2016

Re : Faire une macro avec une boucle et un InputBox

Re,

Oui bien sûr, j'aurai du le faire depuis le départ
Pour moi mon fichier n'a rien de particulier
Mais à distance cela peut être obscur

J'ai d’ailleurs fait juste un fichier de principe
Avec les 2 macros
Tu vas pouvoir te rendre compte immédiatement

A+

vgendron · 10 Juin 2016

Re : Faire une macro avec une boucle et un InputBox

euh..
je pense que le problème vient du fait que ta référence DernièreligneTotale qui contient 24 colonnes. et pas 15

Code:

Sub Insertion_Ligne_Nombre()

Dim Nb As Single

'pour demander le nombre de boucles
    Nb = CInt(Application.InputBox("Nombre d'insertion souhaitées ?", "Insertion de lignes", 1, Type:=1))
       'Intercepte l'utilisation du bouton "Annuler" et la croix de fermeture.
       If Nb = 0 Then Exit Sub
   
Application.ScreenUpdating = False 'Pour bloquer le calcul


'Insertion de ligne
    ActiveCell.Rows("1:" & Nb).EntireRow.Select
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    [dernièreligneTotale].Copy Cells(ActiveCell.Row, 2).Resize(Selection.Rows.Count, 24)

Application.ScreenUpdating = True 'Pour réactiver le calcul automatique

End Sub

Gudo · 13 Juin 2016

Re : Faire une macro avec une boucle et un InputBox

Bonjour Vgendron, Youky, Le Forum

Bonjour
J'ai fait pas mal d'essais, mais cela ne viens pas de là
24 ou 15 le résultat est exactement le même
d’ailleurs ma macro actuelle avec ta boucle, le nombre est de 15
et cela fonctionne bien ???

A+

vgendron · 14 Juin 2016

Re : Faire une macro avec une boucle et un InputBox

Hello

voir PJ
la macro Insertion_3 fonctionne bien chez moi..

Gudo · 15 Juin 2016

Re : Faire une macro avec une boucle et un InputBox

Bonjour

Oui je sais, j'avais fait l'essai avant mon dernier post
Mais dans mon fichier, qui a pourtant la même architecture, cela ne fonctionne pas
Tout ce qui est à l'intérieur du tableau est copié, mais pas ce qui est hors du tableau
Et je n'ai pas trouvé la raison ???

A+

vgendron · 15 Juin 2016

Re : Faire une macro avec une boucle et un InputBox

Euh. je ne comprend pas. le "Hors du tableau"

deux cas testés à l'instant avec mon dernier fichier "FichierExempleInsertion2.xlsm" du post #13

je clique sur B10 et bouton "TaDernierMacro"
nombre de lignes 10
l'insertion met 10 lignes "10 a 19"
les valeurs vont de 9 à 18, puis la ligne 20 reprend à 9

Je clique en dehors du tableau en E30, bouton, 5 lignes
j'ai 5 lignes créées (de 30 à 34) avec valeurs de 1 à 5

dans les deux cas: les colonnes B à P sont remplies sur TOUTES les lignes insérées, ainsi que les colonnes R à Y

Faire une macro avec une boucle et un InputBox

Gudo

XLDnaute Junior

vgendron

XLDnaute Barbatruc

Gudo

XLDnaute Junior

vgendron

XLDnaute Barbatruc

youky(BJ)

XLDnaute Barbatruc

Gudo

XLDnaute Junior

vgendron

XLDnaute Barbatruc

Gudo

XLDnaute Junior

vgendron

XLDnaute Barbatruc

Gudo

XLDnaute Junior

Pièces jointes

vgendron

XLDnaute Barbatruc

Gudo

XLDnaute Junior

vgendron

XLDnaute Barbatruc

Pièces jointes

Gudo

XLDnaute Junior

vgendron

XLDnaute Barbatruc

Discussions similaires