Code insertion de lignes

Bonjour ,

Je recherche une possibilité , pour varier le nombre de lignes à insérer ou à défalquer dans cette macro , sans avoir pour autant à supprimer ou insérer une ligne .

Selection.Insert Shift:=xlDown , par exemple si possible garder 1 seule ligne comme celle- ci en y ajoutant seulement le nombre d'insertion de lignes souhaitées.

Merci

Sub Macro4()
'
' Macro4 Macro

    Sheets("base de données").Select
    Rows("2:2").Select
    Selection.Insert Shift:=xlDown
    Selection.Insert Shift:=xlDown
    Selection.Insert Shift:=xlDown
    Selection.Insert Shift:=xlDown
    Selection.Insert Shift:=xlDown
    Selection.Insert Shift:=xlDown
    Selection.Insert Shift:=xlDown
    Selection.Insert Shift:=xlDown
    Selection.Insert Shift:=xlDown
    Selection.Insert Shift:=xlDown
    Selection.Insert Shift:=xlDown
    Selection.Insert Shift:=xlDown
    Selection.Insert Shift:=xlDown
    Selection.Insert Shift:=xlDown
    Selection.Insert Shift:=xlDown
    Selection.Insert Shift:=xlDown
    Sheets("Saisie").Select
    Range("A2:k17").Select
    Selection.Copy
    Sheets("base de données").Select
    Range("A2").Select
    ActiveSheet.Paste
    Sheets("Saisie").Select
    Range("C2").Select

Bonsoir à tous,

ici, insère des lignes à la suite de la colonne "A"

avec les formules s'il y en a

Sub InsertLignes() 'copie ligne et efface données sans formules
Dim Lg%, Rep
    Lg = Range("A65536").End(xlUp).Row
    Do
        Rep = Application.InputBox("Combien de lignes à ajouter ?", "Ajoute lignes", 1, Type:=1)
        If Rep = False Then Exit Sub  'bouton  Annuler
    Loop While Rep = ""

    Rows(Lg).Copy
    Range(Rows(Lg + 1), Rows(Lg + Rep)).Insert
    Application.CutCopyMode = False
    Range(Rows(Lg + 1), Rows(Lg + Rep)).SpecialCells(xlCellTypeConstants, 23).ClearContents
End Sub

Amicalement

Claude

Bonsoir ,

Est-il possible également de choisir le numéro de la ligne ou l'on souhaite rajouter la ou les lignes à suivre

Merci

Bonjour,

En double cliquant sur la ligne à insérer, çà irait ?

Claude

Bonjour ,

Oui , cela serait parfait

Merci

re,

Dans le VBE de la feuille

Double clic sur ligne à insérer colonne "A" (copie la ligne du dessus)

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim Lg%, Rep
    If Not Application.Intersect(Target, Columns("a")) Is Nothing Then
        If Target.Count > 1 Then Exit Sub
        Lg = Target.Row - 1
        Do
            Rep = Application.InputBox("Combien de lignes à ajouter ?", "Ajoute lignes", 1, Type:=1)
            If Rep = False Then Exit Sub  'bouton  Annuler
        Loop While Rep = ""

        Rows(Lg).Copy
        Range(Rows(Lg + 1), Rows(Lg + Rep)).Insert
        Application.CutCopyMode = False
        On Error Resume Next 'si ligne vide
        Range(Rows(Lg + 1), Rows(Lg + Rep)).SpecialCells(xlCellTypeConstants, 23).ClearContents
    End If
End Sub

Bonne journée

Claude