Comment modifier code pour ajouter x lignes via inpoutbox

fenec

XLDnaute Impliqué
Bonjour le forum

J’aimerais apporter des modifications à mon code afin qu'il puisse ajouter plus qu'une ligne.
Suis parvenu à mettre un inputbox mais pour le reste je bloque

Code:
Sub Ajouter_lignes()

   Dim P As Range
   Dim nbrLig As Integer
   
   nbrLig = InputBox("Combien de ligne voulez-vous rajouter ?", Title:="Lignes")
       If nbrLig = 0 Then
         Exit Sub
       Else
             
   Set P = Cells(Cells(Rows.Count, 2).End(xlUp).Row - 1, 2).Resize(1, 15)
   P.Copy
   P.Insert Shift:=xlDown
   On Error Resume Next
   P.SpecialCells(xlCellTypeConstants).ClearContents
   On Error GoTo 0
   Application.CutCopyMode = False
   Rows(P.Row).RowHeight = 30
   Rows(P.Row + 1).RowHeight = 50
  Set P = Nothing
  
  End If
Application.ScreenUpdating = True

End Sub

Cordialement

Philippe
 

stefan373

XLDnaute Occasionnel
Re : Comment modifier code pour ajouter x lignes via inpoutbox

Bonjour fenec et le forum,

Voilà je pense que cela devrait faire l'affaire. :)

Code:
Sub Ajouter_lignes()
   Dim P As Range
   Dim nbrLig As Integer
   
   nbrLig = InputBox("Combien de ligne voulez-vous rajouter ?", Title:="Lignes")
       If nbrLig = 0 Then
         Exit Sub
       Else
Application.ScreenUpdating = False
   For counter = 1 To nbrLig
   Set P = Cells(Cells(Rows.Count, 2).End(xlUp).Row - 1, 2).Resize(1, 15)
   P.Copy
   P.Insert Shift:=xlDown
   On Error Resume Next
   P.SpecialCells(xlCellTypeConstants).ClearContents
   On Error GoTo 0
   Application.CutCopyMode = False
   Rows(P.Row).RowHeight = 30
   Rows(P.Row + 1).RowHeight = 50
   Next
  Set P = Nothing
   End If
Application.ScreenUpdating = True
End Sub

A+ Stéfan
 

job75

XLDnaute Barbatruc
Re : Comment modifier code pour ajouter x lignes via inpoutbox

Bonsoir fenec, stefan373,

Avec cette méthode on évite la boucle et on n'utilise pas Insert :

Code:
Sub Ajouter_lignes()
Dim nbrLig As Integer, P As Range
nbrLig = Val(InputBox("Combien de ligne voulez-vous rajouter ?", "Lignes"))
If nbrLig = 0 Then Exit Sub
With Cells(Rows.Count, 2).End(xlUp)(0).Resize(, 15) 'avant-dernière ligne
  .Rows(2).Copy .Rows(nbrLig + 2)
  Set P = .Rows(2).Resize(nbrLig)
  .Copy P
  On Error Resume Next
  P.SpecialCells(xlCellTypeConstants).ClearContents
  On Error GoTo 0
  P.RowHeight = 30
  .Rows(nbrLig + 2).RowHeight = 50
End With
End Sub
Edit : la dernière ligne étant copiée plus bas, il faudra peut-être mettre des signes $ dans les formules de cette ligne.

A+
 
Dernière édition:

job75

XLDnaute Barbatruc
Re : Comment modifier code pour ajouter x lignes via inpoutbox

Bonjour fenec, le fil,

Cette macro est plus simple :

Code:
Sub Ajouter_lignes()
Dim nbrLig As Integer
nbrLig = Abs(Val(InputBox("Combien de ligne voulez-vous rajouter ?", "Lignes")))
If nbrLig = 0 Then Exit Sub
With Cells(Rows.Count, 2).End(xlUp).Resize(nbrLig, 15) 'sur dernière ligne
  .Rows(1).Copy .Rows(nbrLig + 1)
  .Rows(0).Copy .Rows 'copie de l'avant-dernière ligne
  On Error Resume Next
  .SpecialCells(xlCellTypeConstants).ClearContents
  On Error GoTo 0
  .RowHeight = 30
  .Rows(nbrLig + 1).RowHeight = 50
End With
End Sub
Nota : j'ai ajouté la fonction Abs en cas d'entrée d'un nombre négatif...

A+
 

fenec

XLDnaute Impliqué
Re : Comment modifier code pour ajouter x lignes via inpoutbox

Bonjour le forum,Job75

Ne vois pas bien l'intéret de mettre un nombre négatif pour ensuite ajouter x lignes ou alors ne comprends pas ta logique.

Pour moi l'entrée d'un nombre négatif serait plutôt pour supprimer les lignes ajouter en trop.

Vu que tu as rajouté cette condition pourrais tu m'expliqué à quoi tu penses?

Cordialement

A+
 

job75

XLDnaute Barbatruc
Re : Comment modifier code pour ajouter x lignes via inpoutbox

Re,

La logique est simple.

Quand on demande d'entrer une donnée dans une InputBox, il faut toujours prévoir le cas où l'utilisateur entre n'importe quoi.

A+
 

Statistiques des forums

Discussions
312 294
Messages
2 086 893
Membres
103 404
dernier inscrit
sultan87