excel : XML probleme de tableau

Sub déListe()
    Sheets("Feuil1").ListObjects("Liste1").Unlist
End Sub

Sub CréerTable()
    ActiveSheet.ListObjects.Add(xlSrcRange, Range("$B$5:$D$7"), , xlYes).Name = _
        "Liste1"
    Range("Liste1[#All]").Select
End Sub

'Vider une table de son contenu

With Sheets("'Feuil1").ListObjects("Liste1")
    If Not .DataBodyRange Is Nothing Then .DataBodyRange.Delete
End With
'Si il y a des formules dans les cellules de la table, elles sont conservées et lorsque vous collez de nouvelles données dans cette table,
' manuellement ou par macro, elles seront actives.
'Si vous souhaitez aussi effacer les formules, il faut vider le contenu de la table avant de supprimer les lignes :
     
With Sheets("Feuil1").ListObjects("Liste1")
    If Not .DataBodyRange Is Nothing Then
        .DataBodyRange.ClearContents
        .DataBodyRange.Delete
    End If
End With

Private Sub AjoutLigne()
Dim LR As ListRow
Set LR = Range("Liste1").ListObject.ListRows.Add(1)
LR.Range.Cells(1, 1) = "pomme"
LR.Range.Cells(1, 2) = "d'api"
LR.Range.Cells(1, 3) = "tapis"

End Sub