XL 2010 Insérer des lignes au milieu d'un tableau

  • Initiateur de la discussion Initiateur de la discussion bepo08
  • Date de début Date de début

bepo08

XLDnaute Nouveau
Bonjour,
J'ai écrit une macro pour insérer des lignes dans un tableau, malheureusement cela ne fait pas ce que je veux
Après avoir fait de nombreux essais je n'arrive pas à m'en sortir
Si quelqu'un peut me secourir

Sub Macro7()
'
' Macro1 Macro
'
QU = InputBox("Combien voulez vous insérer de lignes.", "Insertion de lignes")
If QU = 0 Or QU = "" Then Exit Sub

Ref = InputBox("Numéro de la ligne au dessous de laquelle on vas insérer des lignes", "Numéro de ligne")
If Ref = 0 Or Ref = "" Then Exit Sub

'On sélectionne la ligne à copier (Ref)
Rows(Ref).Select

'On sélectionne le nombre de ligne à insérer qui doit correspondre à "Qu" de l'inputbox
Range(Rows(Ref + 1), Rows(QU - 1)).Select

'on insert les lignes
Selection.Insert Shift:=xlDown 'CopyOrigin:=xlFormatFromLeftOrAbove

'On sélectionne la ligne à copier
Rows(Ref).Select
Selection.Copy

'On copie la ligne sélectionnée sur les lignes insérées
Range(Rows(Ref + 1), Rows(Ref + QU)).Select
ActiveSheet.Paste

'On sélectionne les cellules de la colonne "A" des lignes insérées
'+ la dernières cellules afin d'incrémenter les N°
Range(Cells(Ref, 1), Cells(Ref, 1)).Select
'On renumérote les lignes colonne A
Selection.AutoFill Destination:=Range(Cells(Ref, 1), Cells(Ref + 1 + QU, 1)), Type:=xlFillDefault


'Boite de message
MsgBox "Vous avez inséré " & NbL & " Lignes" & vbCrLf & " " & vbCrLf & "Enregister le fichier"


End Sub
 

Pièces jointes

job75

XLDnaute Barbatruc
Bonsoir bepo08,
Code:
Sub Insertion()
Dim Qu, Ref
Qu = Val(InputBox("Nombre de lignes :", "Insertion de lignes"))
If Qu = 0 Then Exit Sub
Ref = Val(InputBox("Numéro de la ligne au dessous de laquelle on insère des lignes :", "Numéro de ligne"))
If Ref = 0 Then Exit Sub
Rows(Ref).Copy
Rows(Ref + 1).Resize(Qu).Insert
Application.CutCopyMode = 0
On Error Resume Next 'si aucune SpecialCell
[A:A].SpecialCells(xlCellTypeConstants, 1).DataSeries 'numérotation
End Sub
A+
 

Pièces jointes

bepo08

XLDnaute Nouveau
Merci beaucoup, pour votre aide, en combinant vos lignes de codes avec ce que j'avais déjà, ma macro fonctionne parfaitement bien.
MERCI

J'aurais une autre requête, sur laquelle je n'est pas du tout avancé :
Je voudrais pouvoir faire des sous-totaux par paragraphe, MAIS sans que cela ne me rajoute une ligne (comme cela se fait en automatique sous Excel)
 

Discussions similaires

Réponses
12
Affichages
545
Réponses
3
Affichages
424

Membres actuellement en ligne

Statistiques des forums

Discussions
315 283
Messages
2 118 015
Membres
113 408
dernier inscrit
lausablk