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
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