Recopie incrémentée

Bonjour à tous,

Toujours dans l'apprentissage de VBA, je suis bloqué sur un point. Rien de compliqué mais je n'ai pas réussi à faire marcher mes codes jusqu'à présent, raison pour laquelle je vous appelle à l'aide. J'ai un fichier Excel contenant un tableau (voir exemple en PJ).

J'aimerai avoir un code qui ajoute une ligne en bas du tableau et incrémente la valeur sur la colonne A en bas du tableau.

Est ce que vous pouvez m'aider ?

Merci !

bonjour, une proposition (situation la plus simple)

Sub Ajouter()
     With Sheets("feuil1").ListObjects("Tableau1")
          If .ListRows.Count Then     'le tableau n'est pas vide
               sp = Split(.DataBodyRange.Cells(.ListRows.Count, 1), "-")     'séparer la derniere cellule-A sur le charactère "-"
               sp(1) = Format(sp(1) + 1, "0000")     'incrementer 2ieme element & format "0000"
               s = Join(sp, "-")     'joindre les 2 elements de nouveau
          Else     'le tableau était vide
               s = "1-1000"     'point de départ
          End If
          .ListRows.Add.Range.Range("A1").Value = s   'ajouter une ligne avec cette cellule
     End With
End Sub

Bonjour

Un essai à tester. Te convient-il ?

Bye !

re,

les entêtes doivent être dans la premiere ligne de la feuille active, autrement ...

? ? ?

re,

Sub AjouterUneLigne()

     With Range("Tableau1")     'le tableau
          Set sh = .Parent     'la feuille du tableau
          ln = .Rows.Count + .Row     'correction si les entêtes ne sont pas sur la premiere ligne
          sh.Cells(ln - 1, .Column).AutoFill Destination:=sh.Cells(ln - 1, .Column).Resize(2), Type:=xlFillDefault     'correction si la feuille active n'est pas celle du tableau et/ou la première colonne du tableau n'est pas A
     End With

End Sub

combinaison des deux

Sub Ajouter2()
     With Range("Tableau1").ListObject     'option 1
     'With Sheets("feuil1").ListObjects("Tableau1")     'option 2
          Set c = .ListRows.Add.Range
          If .ListRows.Count > 1 Then c.Cells(0, 1).AutoFill Destination:=c.Cells(0, 1).Resize(2), Type:=xlFillDefault
     End With
End Sub

Bonjour à tous et merci pour vos réponses. La réponse de gmb me convient, les entêtes ne changerons pas de place.

Merci beaucoup !