XL 2016 macro pour vider le contenu d'un tableau synthese ( avant d’actualiser par les nouvelles données )

[tuti]

bonjour,

la macro pour actualiser une feuille de synthese fonctionne bien
mais il peux arriver que je supprime des onglets ( lors du reset de la nouvel année )

hors dans ce cas précis ( si les onglets n'existent plus ), les anciennent donnée ne disparaissent pas

plutot que d'alourdir la première macro, serait il possible d'avoir une petite macro qui vide le contenu du fichier


attention toutefois, dans la colonne S, j'ai insérer une petite formule pour convertir un nombre de jour en période ( année mois jour )
je souhaiterais que la macro n'efface pas le contenu de cette colonne


merci

 

[sylvanu]

Bonsoir Tuti,
Un essai en Pj avec en Module2 :

Sub EffacerTableau()
With Sheets("Synthese")
    .Unprotect
    .[Tableau12].ListObject.DataBodyRange.Delete
    .Protect
End With
End Sub

Pour la colonne S ne vous inquiétez pas, même si la cellule semble vide la formule est conservée.
C'est un des avantages des tableaux structurés.

 

[laurent950]

Bonsoir @tuti

Lorsqu'une feuille d'un onglet est supprimé lancer cette vba en premier, puis ensuite effectuer la mise à jours des données a récupérer des onglets vers la feuille synthèses.

a essayer ci-dessous.

Option Explicit

Sub SupprimerLignesOngletsSupprimes()
    ' Déclare le classeur actif
    Dim wb As Workbook
    Set wb = ThisWorkbook ' Utilise le classeur actif
    
    ' Déclare la feuille cible où se trouve le tableau
    Dim targetSheet As Worksheet
    Set targetSheet = wb.Sheets("Synthese") ' Remplace "Synthese" par le nom de ta feuille
        targetSheet.Activate
    
    ' Déverrouille la feuille pour permettre les modifications
    targetSheet.Unprotect
    
    ' Déclare et assigne le tableau structuré de la feuille cible
    Dim tableau As ListObject
    Set tableau = targetSheet.ListObjects("Tableau12") ' Remplace "Tableau12" par le nom de ton tableau
    
    ' Déclare la plage contenant les données de la première colonne du tableau
    Dim Plg As Range
    Set Plg = tableau.ListColumns(1).DataBodyRange
    
    ' Déclare la variable pour la boucle et la collection pour stocker les lignes à supprimer
    Dim Rng As Range
    Dim cln As Collection
    Set cln = New Collection ' Initialise une nouvelle collection pour les lignes à supprimer

    ' Déclare une variable pour le nom de la feuille
    Dim wsName As Variant
    
    ' Parcours chaque cellule de la plage définie
    For Each Rng In Plg
        Rng.Select ' Sélectionne la cellule courante
        
        On Error Resume Next ' Ignore les erreurs si l'onglet n'existe pas
        Set wsName = Worksheets(CStr(Split(Rng.Value, " ")(0))) ' Essaye d'obtenir la feuille en fonction du nom trouvé
        
        ' Si une erreur est détectée (feuille non trouvée), ajoute la ligne à la collection
        If Err Then
            'Debug.Print Rng.Value ' Affiche la valeur de la cellule dans la fenêtre d'exécution
            'Debug.Print Rng.Row   ' Affiche le numéro de la ligne de la cellule
            cln.Add Item:=Rng.Row, Key:=CStr(Split(Rng.Value, " ")(0)) ' Ajoute la ligne à la collection
        End If
        
        On Error GoTo 0 ' Réinitialise la gestion d'erreurs à l'état normal
    Next Rng

    
    ' Parcours inversé de la collection pour supprimer les lignes
    Dim i As Long
    For i = cln.Count To 1 Step -1
        'Debug.Print cln(i) ' Affiche les éléments dans l'ordre inverse
        targetSheet.Rows(CLng(cln(i))).Delete ' Supprime la ligne correspondante
    Next i
    
    ' Réactive la protection de la feuille
    targetSheet.Protect
    
    ' Décharge les variables utilisées
    Set wb = Nothing
    Set targetSheet = Nothing
    Set tableau = Nothing
    Set Plg = Nothing
    Set Rng = Nothing
    Set wsName = Nothing
    Set cln = Nothing ' Décharge la collection
    i = Empty
End Sub

 

[tuti]

dans mon tableau final, je colle la macro
puis j'ajoute un objet et j'associe la macro,
j'ai le popup CETTE FORMULE EST TROP COMPLIQUEE POUR ETRE AFFECTEE A UN OBJET

pour les 3 , j'ai le même message


sur ma version forum du fichier, pas de soucis avec la version de @sylvanu ( pas encore essayer les autres )
par contre, si le tableau est déjà vide ( si je clique une 2eme fois sur l'objet), j'ai un message d'erreur ( le tableau étant vide )

 

[sylvanu]

Le moyen le plus simple, même si ce n'est pas le plus propre :

Sub EffacerTableau()
On Error Goto Fin
With Sheets("Synthese")
    .Unprotect
    .[Tableau12].ListObject.DataBodyRange.Delete
    .Protect
End With
Fin:
End Sub

 

[Phil69970]

Re

Il faut tester si le tableau est vide et le vider si il n'est pas vide

If Not Range("nom du tableau").ListObject.DataBodyRange Is Nothing Then Range("nom du tableau").ListObject.DataBodyRange.Delete

Donc pour tableau2 cela donne

If Not Range("Tableau2").ListObject.DataBodyRange Is Nothing Then Range("Tableau2").ListObject.DataBodyRange.Delete

 

[tuti]

avec ta modification, on peux s'amuser à faire apparaitre puis supprimer les infos

par contre quand je colle le texte de la macro dans mon document final, , j'ai toujours le même le popup CETTE FORMULE EST TROP COMPLIQUEE POUR ETRE AFFECTEE A UN OBJET
j'ai regarder , j'ai le bon nom de tableau

je regarderais demain quitte à faire réimporter les infos

 

[TooFatBoy]

Bonjour,

Le moyen le plus simple, même si ce n'est pas le plus propre :

Sub EffacerTableau()
On Error Goto Fin
With Sheets("Synthese")
    .Unprotect
    .[Tableau12].ListObject.DataBodyRange.Delete
    .Protect
End With
Fin:
End Sub

Pardon pour cette question, mais est-ce que si le TS est déjà vide, on ne sort pas de la Sub sans reprotéger la feuille ?

Si oui, je pense qu'il suffit de remplacer le Goto par un Resume Next.