Sub AjoutLignes()
Dim lo As ListObject
Dim lx As Long
Set lo = ThisWorkbook.Sheets("amigo").ListObjects("Tableau3")
If Not lo.DataBodyRange Is Nothing Then
On Error GoTo FIN_IF
Application.ScreenUpdating = False
For lx = lo.ListRows.Count To 1 Step -1
If lo.ListRows(lx).Range(1) <> "" Then lo.ListRows.Add lx + 1
Next
FIN_IF:
Application.ScreenUpdating = True
End If
End Sub