Microsoft 365 Redimensionner un tableau structuré Excel en VBA

iliess

XLDnaute Occasionnel
Bonsoir
J'utilise le code suivant pour redimensionner un tableau structuré Excel en VBA.

VB:
Sub Redimensionner()
ActiveSheet.ListObjects("Tableau1").Unlist
Cells.ClearFormats
ActiveSheet.ListObjects.Add(xlSrcRange, Range("A4:12"), , xlYes).Name = "Tableau1"
Range("A1:I3").Clear
End Sub

En augmentant le nombre de lignes (445621 lignes), le temps d'exécution du code augmente considérablement. J'essaie donc d'éviter .Unlist et remplacez le code par .Resize

Code:
Sub Macro1()
    ActiveSheet.ListObjects("Tableau1").Resize Range("$A$4:$I$12")
End Sub

Erreur d'exécution '1004': le code ca marche pas

Cordialement
 

Pièces jointes

  • Redimensioner un tableau.xlsm
    17.3 KB · Affichages: 3
Solution
Bonsoir, Mr @mapomme Grâce à votre réponse, j'ai une idée très facile.
-1 Changer les en tête par les valeurs de A4 à I4
-2 insérer 3 ligne
-3 copie les lignes 2 et 3 du tableau 1.

voici le code finale
VB:
Sub traitement()
Dim ShAuxi As Worksheet
Set ShAuxi = Sheets("Feuil1")
With ShAuxi
    .Range("A1:I1").Value = .Range("A4:I4").Value
    .Rows("1:3").Insert Shift:=xlDown
    .Range("A1:I2").Value = .Range("A5:I6").Value
    .ListObjects("Tableau1").DataBodyRange.Rows("1:3").Delete
   
End With
End Sub

Dranreb

XLDnaute Barbatruc
Bonsoir.
Voyez si ce poste peut résoudre votre problème
 

Gégé-45550

XLDnaute Accro
Mais en fait, pourquoi veux-tu "redimensionner" le TS ?
Bonsoir,
C'est la bonne question que pose l'ami TooFatBoy.
Soit on a besoin d'y ajouter ou de supprimer des lignes et ce n'est pas la bonne commande, soit on veut le vider complètement et ce n'est toujours pas la bonne commande ... et si par hasard on cherche à ajouter des lignes vides, c'est une très mauvaise idée.
Cordialement
 

iliess

XLDnaute Occasionnel
Bonsoir Mr @TooFatBoy , Mr @Gégé-45550
je vous explique mieux
après l'ouverture d'un grand fichier Excel par Power Query voici le poste :https://excel-downloads.com/threads/ouvrir-un-fichier-excel-rapidement-en-vba.20082355/post-20638684

voici résultat du fichier
1712707101450.png


voici résultat souhaité

1712707209835.png
 

mapomme

XLDnaute Barbatruc
Supporter XLD
Bonsoir,

Le code fonctionne très bien et très rapidement chez moi à la condition que :
1712706940302.png


Les en-têtes de votre TS "tableau1" sont en ligne 1.

Cette instruction ne fonctionne pas :
ActiveSheet.ListObjects("Tableau1").Resize Range("A4:I12") <-- vous changez de ligne les en-têtes

Celle-ci fonctionne car on ne change pas de ligne l'emplacement des en-têtes:
ActiveSheet.ListObjects("Tableau1").Resize Range("A1:I12") <-- vous conservez la ligne d'en-têtes à sa place
 
Dernière édition:

iliess

XLDnaute Occasionnel
Bonsoir, Mr @mapomme Grâce à votre réponse, j'ai une idée très facile.
-1 Changer les en tête par les valeurs de A4 à I4
-2 insérer 3 ligne
-3 copie les lignes 2 et 3 du tableau 1.

voici le code finale
VB:
Sub traitement()
Dim ShAuxi As Worksheet
Set ShAuxi = Sheets("Feuil1")
With ShAuxi
    .Range("A1:I1").Value = .Range("A4:I4").Value
    .Rows("1:3").Insert Shift:=xlDown
    .Range("A1:I2").Value = .Range("A5:I6").Value
    .ListObjects("Tableau1").DataBodyRange.Rows("1:3").Delete
   
End With
End Sub
 

Discussions similaires

Statistiques des forums

Discussions
314 717
Messages
2 112 169
Membres
111 449
dernier inscrit
jhugot