Ajout automatique ligne sous en-tête

Bonjour,

Mon problème est un peu similaire à ce poste (ais je n'arrive pas à adapter le code. Peut-être il ne faut pas du tout reprendre le même ? Bref, mon besoin est qu'une nouvelle ligne se créé automatiquement sous la ligne des en-têtes dès que la deuxième ligne du tableau est remplie.

De manière plus concrète :
J'ai un tableau (ci-joint) avec 7 colonnes (de A à G), les en-têtes sont en ligne 4.
La ligne 5 est vierge de donnée mais contient des formules et des listes. De plus, elle est masquée afin d'être la ligne de référence lors de l'ajout de nouvelles lignes (pour ne pas avoir une nouvelle ligne similaire à celle de l'en-tête ^^). J'aurai besoin que dès que la ligne 6 est remplie, une nouvelle ligne se créé (vierge mais contenant les formules et listes de la ligne 5), et s'ajoute automatiquement au-dessus de la précédente. La nouvelle ligne devient donc la ligne 6 et la ligne 6 qui vient d'être remplie devient la ligne 7, etc...

Voici le code sur lequel de me base (Merci AntoineDL !) :

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    Application.ScreenUpdating = False 'Désactive la mise à jour de l'écran
    'Application.EnableEvents = True 'Désactive la gestion des évènements
    If Range("A1").Value = "SAISIE DES OPERATIONS" And Target.Row > 35 And (Target.Column = 2 Or Target.Column = 3 Or Target.Column = 5) Then   'La procédure s'exécute que si : la feuille est intitulée SAISIE DES OPERATIONS et si une seule cellule est modifiée dans la colonne B, C ou E à partir de la ligne 35.
        CelluleActive = ActiveCell.Address 'Mémorise l'adresse de la cellule sélectionnée
        DerniereLigneTableau = Range("G3").End(xlDown).Row 'Détermine la dernière ligne du tableau
        If Cells(Target.Row, Target.Column).Value = "" Then 'Si la valeur d'une cellule est effacée en B, C ou E, la macro ne s'exécute pas
            Exit Sub
        ElseIf DerniereLigneTableau - Target.Row = 2 Then 'Si l'avant-dernière ligne est complétée :
            Range("A" & Target.Row + 1 & ":L" & Target.Row + 1).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove 'insère une ligne
            Range("A" & Target.Row + 2 & ":L" & Target.Row + 2).Copy 'copie la dernière ligne du tableau
            Range("A" & Target.Row + 1 & ":L" & Target.Row + 1).PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, SkipBlanks:=False, Transpose:=False 'colle les formules dans les cellules insérées
            Range("A" & Target.Row + 1).Value = Range("A" & Target.Row) + 1 'affecte le numéro d'opération dans la cellule A
            For i = Target.Row + 1 To DerniereLigneTableau 'Rétablit la hauteur des lignes à 37.5
                Rows(i).RowHeight = 37.5
            Next
        End If
        Range(CelluleActive).Select 'Resélectionne la cellule avant l'insertion
        Application.CutCopyMode = False 'Désactive le mode copy
    End If
    'Application.EnableEvents = True 'Réactive la gestion des évènements
End Sub

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    Application.ScreenUpdating = False 
    'Application.EnableEvents = True 
    If Range("A1").Value = "Journal de suivi des revenus et des dépenses" And Target.Row = 6 And (Target.Column = 2 Or Target.Column = 3 Or Target.Column = 7 Or Target.Column = 8) Then   
        CelluleActive = ActiveCell.Address 
---- et là commence mon incompréhension... ----
        PremiereLigneTableau = Range("B5").End(xl).Row  ???
        If Cells(Target.Row, Target.Column).Value = ""
            Exit Sub
        ElseIf PremiereLigneTableau + Target.Row = 1 Then 
---- arrêt de l'essai d'adaptation du code à partir de là ----
            Range("A" & Target.Row + 1 & ":L" & Target.Row + 1).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove 
            Range("A" & Target.Row + 2 & ":L" & Target.Row + 2).Copy 
            Range("A" & Target.Row + 1 & ":L" & Target.Row + 1).PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, SkipBlanks:=False, Transpose:=False 
            Range("A" & Target.Row + 1).Value = Range("A" & Target.Row) + 1 
            For i = Target.Row + 1 To DerniereLigneTableau 
                Rows(i).RowHeight = 37.5
            Next
        End If
        Range(CelluleActive).Select 
        Application.CutCopyMode = False 
    End If
    'Application.EnableEvents = True 
End Sub

Si quelqu'un.e peut m'éclairer je serai ravie !

Bonjour,

Une proposition alternative, dans votre cas il y a moyen de faire plus simple selon moi. Ci-joint votre fichier et ci-après le code.

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim inputRow As Range
  Set inputRow = Range("A6:G6")

  If Intersect(Target, inputRow) Is Nothing Then Exit Sub

  Dim checkRng As Range
  Set checkRng = Nothing
  On Error Resume Next
  Set checkRng = inputRow.SpecialCells(xlCellTypeBlanks)
  On Error GoTo 0

  If checkRng Is Nothing Then                    ' la ligne est pleine, il faut insérer
    inputRow.Insert xlShiftDown, xlFormatFromLeftOrAbove
  End If

End Sub

Bonjour,

Essayez ceci :

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Row <> 6 Then Exit Sub

    Dim i As Integer
    For i = 1 To 5
        If Me.Cells(6, i) = "" Or (Me.Cells(6, 6)) = "" And (Me.Cells(6, 7)) = "" Then Exit Sub
    Next i

    Rows("6:6").Select
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("A6").Select
End Sub

Je vous remercie tou(te)s les deux pour vos codes, précisions et rapidité !

Après essais et adaptations, je préfère utiliser le code d'Optimix afin de pouvoir remplir que certaines cellules et pas toute la ligne.

Bien à vous

bonjour CamErgo, Salut Optimix, Saboh12617

comme c'est un tableau, on le traite comme un tableau

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
     Dim N
     With Me.Range("tableau1").ListObject
          N = .ListRows.Count
          If N = 0 Then .ListRows.Add: .ListRows(1).Range.EntireRow.Hidden = True
          If N < 2 Then .ListRows.Add
          Set c = .ListRows(2).Range
          If Intersect(c, Target) Is Nothing Then Exit Sub
          If WorksheetFunction.CountA(c.Offset(, 1).Resize(, 4)) = 4 And WorksheetFunction.CountA(c.Offset(, 5).Resize(, 2)) >= 1 Then .ListRows.Add 2, xlFormatFromLeftOrAbove
     End With
End Sub

(Peut-être encore à améliorer si le tableau contenait aucune ligne)