XL 2016 insérer un tableau en VBA

R1-

XLDnaute Junior
Bonjour,

Je cherche à insérer un tableau qui reprendrai les données de tous les tableaux de tous les onglets. je souhaite utiliser une Macro pour faire ceci et j'aimerai que ce tableau soit indépendant du nombre d'onglets du classeur. J'ai déjà déclaré plusieurs variables dans la macro précédente pour définir les onglets selon leur place et non pas selon leur nom.
Merci par avance pour votre aide.

Erwan
 

Pièces jointes

  • classeur exemple.xlsm
    28.8 KB · Affichages: 5
Solution
"438 Propriété ou méthode non gérée par cet objet" à cette ligne
Certainement une erreur de copier/coller.
En étudiant et comprenant les lignes, vous auriez constaté qu'il manquait un point, que le CurrentRegion.ClearContents est différent de Range("A1").Clear, qu'il était là pour nettoyer la feuille d'éventuelles anciennes données.

Dans la création de votre tableau vous donnez un nom par variable. Et cette variable est vide : NomTable = ""

Copier / Coller des bouts de codes trouver ici où là sans les comprendre, ne vous mènera pas bien loin dans l'étude de vba.
VB:
Sub tableau()

    Dim table As ListObject
    Dim NomTable As String
    Dim ws As Worksheet
    Dim dest As Range...

Hasco

XLDnaute Barbatruc
Repose en paix
Bonjour,
je souhaite utiliser une Macro pour faire ceci
Vous avez excel 2016, pourquoi ne pas utiliser Power-Query, avec des tableaux structurés ?

Sinon voici une macro qui vous le fera :
VB:
Sub ConsNom()
    Dim ws As Worksheet
    Dim dest As Range
    
    With ThisWorkbook.Sheets("CONSO")
        .Range("A1").CurrentRegionClearContents
        .Range("A1:B1") = Array("Ville", "Données")
    End With
    For Each ws In ThisWorkbook.Worksheets()
        If ws.Name <> "CONSO" And ws.Name <> "Menu" Then
            Set dest = ThisWorkbook.Sheets("CONSO").Cells(Rows.Count, 1).End(xlUp)(2)
            With ws.Range("A1").CurrentRegion
                dest.Resize(.Rows.Count - 1, .Columns.Count).Value = .Offset(1).Resize(.Rows.Count - 1).Value
            End With
      
        End If
    Next
End Sub

Cordialement
 
Dernière édition:

R1-

XLDnaute Junior
J'avais une erreur "438 Propriété ou méthode non gérée par cet objet" à cette ligne
VB:
.Range("A1").CurrentRegionClearContents
J'ai remplacé le CurrentRegionClearContents par un clear.
De plus, j'aimerai rentrer ces données dans un tableau comme suis mais j'ai une erreur 1004 "Erreur définie par l'application ou par l'objet" à la ligne 25. Cependant, le tableau s'affiche quand même.
Voici le code
Code:
Sub tableau()

    Dim table As ListObject
    Dim NomTable As String
    Dim ws As Worksheet
    Dim dest As Range
    
    Sheets("CONSO").Range("A1:Z65000").ClearContents
    
    With ThisWorkbook.Sheets("CONSO")
        .Range("A1").Clear
        .Range("A1:B1") = Array("Ville", "Données")
    End With
    For Each ws In ThisWorkbook.Worksheets()
        If ws.Name <> "CONSO" And ws.Name <> "Menu" Then
            Set dest = ThisWorkbook.Sheets("CONSO").Cells(Rows.Count, 1).End(xlUp)(2)
            With ws.Range("A1").CurrentRegion
                dest.Resize(.Rows.Count - 1, .Columns.Count).Value = .Offset(1).Resize(.Rows.Count - 1).Value
            End With
      
        End If
    Next
    
    With ThisWorkbook.Sheets("CONSO")
    'On Error Resume Next
    .ListObjects.Add(xlSrcRange, .Range("A1:B" & Sheets("CONSO").Range("A65500").End(xlUp).Row), , xlYes).Name = NomTable
    End With

End Sub
Et le fichier
 

Pièces jointes

  • classeur exemple.xlsm
    33.7 KB · Affichages: 2

Hasco

XLDnaute Barbatruc
Repose en paix
"438 Propriété ou méthode non gérée par cet objet" à cette ligne
Certainement une erreur de copier/coller.
En étudiant et comprenant les lignes, vous auriez constaté qu'il manquait un point, que le CurrentRegion.ClearContents est différent de Range("A1").Clear, qu'il était là pour nettoyer la feuille d'éventuelles anciennes données.

Dans la création de votre tableau vous donnez un nom par variable. Et cette variable est vide : NomTable = ""

Copier / Coller des bouts de codes trouver ici où là sans les comprendre, ne vous mènera pas bien loin dans l'étude de vba.
VB:
Sub tableau()

    Dim table As ListObject
    Dim NomTable As String
    Dim ws As Worksheet
    Dim dest As Range

    Sheets("CONSO").Range("A1:Z65000").ClearContents

    With ThisWorkbook.Sheets("CONSO")
        '
        ' Nettoyer d'anciennes et éventuelles données.
        .Range("A1").CurrentRegion.ClearContents
        '
        ' Inscrire l'entête
        .Range("A1:B1") = Array("Ville", "Données")
    End With

    For Each ws In ThisWorkbook.Worksheets()
        If ws.Name <> "CONSO" And ws.Name <> "Menu" Then
            '
            ' Prochaine cellule libre en colonne 1 de la feuille CONSO
            Set dest = ThisWorkbook.Sheets("CONSO").Cells(Rows.Count, 1).End(xlUp)(2)
            '
            ' Copier par valeur les données d'une plage à une autre
            With ws.Range("A1").CurrentRegion
                dest.Resize(.Rows.Count - 1, .Columns.Count).Value = .Offset(1).Resize(.Rows.Count - 1).Value
            End With

        End If
    Next

    With ThisWorkbook.Sheets("CONSO")
        .ListObjects.Add(xlSrcRange, .Range("A1").CurrentRegion, , xlYes).Name = "T_Datas"
    End With

End Sub
 

Discussions similaires

  • Résolu(e)
Microsoft 365 VBA - Tableau
Réponses
10
Affichages
403

Statistiques des forums

Discussions
311 733
Messages
2 082 019
Membres
101 872
dernier inscrit
Colin T