VBA Création tableau croisé Dynamique

Bonjour à tous,

Je cherche un créer un tableau croisé dynamique via VBA. Dans mon code je souhaite que la source du tableau s'ajuste automatiquement jusqu'à la dernière ligne non vide de mon fichier.

Mon tableau source commence à la cellule A3 jusqu'à la colonne F

Quand je fais l'enregistreur de macro, voila ce que ça me donne =>

Sheets.Add

ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _

"Feuil1!R3C1:R14C6", Version:=xlPivotTableVersion12).CreatePivotTable _

TableDestination:="Feuil2!R3C1", TableName:="Tableau croisé dynamique1", _

DefaultVersion:=xlPivotTableVersion12

Sheets("Feuil2").Select

Cells(3, 1).Select

J'ai donc essayé d'adapter le code afin que la source du tableau s'ajuste automatiquement jusqu'à la dernière ligne non vide de mon fichier =>

Dim plage As Range

With Worksheets("Feuil1")

Set plage = .Range("A3:AF" & .Range("A" & Rows.Count).End(xlUp).Row)

End With

Sheets.Add

ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _

plage, Version:=xlPivotTableVersion12). _

CreatePivotTable TableDestination:=ActiveSheet & "!R3C1", TableName:="Tableau croisé dynamique1" _

, DefaultVersion:=xlPivotTableVersion12

Malheureusement le code ne marche pas et cela me fait l'erreur : Erreur d'exécution '438' : Propriété ou méthode non gérée par cet objet.

Quelqu'un peut-il m'aider svp?

Ci-joint le fichier Excel exemple.

275creation-tcd-vba.xlsm (16.96 Ko)

Bonjour,

si les données en "A" sont toujours présentes comme dans les colonnes voisines:

    Dim Last
    Last = [A65000].End(xlUp).Row 'dernière colonne en A
    Set plg = Range("A3:F" & Last) ' la zone devient variable en longueur
    ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
        plg, Version:=xlPivotTableVersion12).CreatePivotTable _
        TableDestination:="Feuil2!R3C8", TableName:="Tableau croisé dynamique1", _
        DefaultVersion:=xlPivotTableVersion12

P.

Bonjour,

Essaie ainsi :

Public Sub CreatePivotTable()
Dim wb As Workbook
Dim wsData As Worksheet, wsPT As Worksheet
Dim lCols As Long, lRow As Long, lRows As Long
Dim Rng As Range
Dim PTCache As PivotCache
Dim PT As PivotTable

    With Application
        .DisplayAlerts = False
        .ScreenUpdating = False
    End With
    '----------------------------------------------------------------------
    Set wb = ActiveWorkbook
    Set wsData = wb.Worksheets("Feuil1")
    '----------------------------------------------------------------------
    On Error Resume Next
    wb.Worksheets("TCD").Delete
    On Error GoTo 0
    '----------------------------------------------------------------------
    lRow = 3
    '----------------------------------------------------------------------
    With wsData
        lRows = .Cells(.Rows.Count, 1).End(xlUp).Row
        lCols = .Cells(3, .Columns.Count).End(xlToLeft).Column
        Set Rng = .Cells(3, 1).Resize(lRows - lRow + 1, lCols)
    End With
    '----------------------------------------------------------------------
    Set PTCache = wb.PivotCaches.Add(xlDatabase, Rng)
    '----------------------------------------------------------------------
    Set wsPT = wb.Worksheets.Add(after:=Worksheets(Worksheets.Count))
    wsPT.Name = "TCD"
    '----------------------------------------------------------------------
    Set PT = PTCache.CreatePivotTable(wsPT.Cells(3, 1), "TCD_1")
    '----------------------------------------------------------------------
    Application.DisplayAlerts = True
    '----------------------------------------------------------------------
    Set PT = Nothing
    Set PTCache = Nothing
    Set Rng = Nothing
    Set wsData = Nothing
    Set wb = Nothing

End Sub

Merci pour ces réponses rapides.

En réalité mon tableau sources fait 147 000 lignes et 40 colonnes (De a jusqu'à AN)

Patrick1957, quand j'essaye d'adapter ton code :

Sub Solution_forum

Dim Last

Last = [A160000].End(xlUp).Row 'dernière colonne en A

Set plg = Range("A3:AN" & Last) ' la zone devient variable en longueur

ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _

plg, Version:=xlPivotTableVersion12).CreatePivotTable _

TableDestination:="Feuil2!R3C8", TableName:="Tableau croisé dynamique1", _

DefaultVersion:=xlPivotTableVersion12

End Sub

Cela me fait l'erreur suivante : Erreur d'exécution '13' : Incompatibilité de type, en surlignant en jaune

ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _

plg, Version:=xlPivotTableVersion12).CreatePivotTable _

TableDestination:="Feuil2!R3C8", TableName:="Tableau croisé dynamique1", _

DefaultVersion:=xlPivotTableVersion12

Re,

As-tu essayé ma proposition ?

Cdlt.

Re jean-Eric,

J'ai également testé ta proposition, cependant quand je lance la macro cela me fait la même erreur => Erreur d'exécution '13' : Incompatibilité de type.

La Partie surlignée en jaune est celle la :

Sub Solution_forum()

Dim Last

Last = [A160000].End(xlUp).Row 'dernière colonne en A

Set plg = Range("A3:AN" & Last) ' la zone devient variable en longueur

ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _

plg, Version:=xlPivotTableVersion12).CreatePivotTable _

TableDestination:="Feuil2!R3C8", TableName:="Tableau croisé dynamique1", _

DefaultVersion:=xlPivotTableVersion12

End Sub

Public Sub CreatePivotTable()

Dim wb As Workbook

Dim wsData As Worksheet, wsPT As Worksheet

Dim lCols As Long, lRow As Long, lRows As Long

Dim Rng As Range

Dim PTCache As PivotCache

Dim PT As PivotTable

With Application

.DisplayAlerts = False

.ScreenUpdating = False

End With

'----------------------------------------------------------------------

Set wb = ActiveWorkbook

Set wsData = wb.Worksheets("Feuil1")

'----------------------------------------------------------------------

On Error Resume Next

wb.Worksheets("TCD").Delete

On Error GoTo 0

'----------------------------------------------------------------------

lRow = 3

'----------------------------------------------------------------------

With wsData

lRows = .Cells(.Rows.Count, 1).End(xlUp).Row

lCols = .Cells(3, .Columns.Count).End(xlToLeft).Column

Set Rng = .Cells(3, 1).Resize(lRows - lRow + 1, lCols)

End With

'----------------------------------------------------------------------

Set PTCache = wb.PivotCaches.Add(xlDatabase, Rng)

'----------------------------------------------------------------------

Set wsPT = wb.Worksheets.Add(after:=Worksheets(Worksheets.Count))

wsPT.Name = "TCD"

'----------------------------------------------------------------------

Set PT = PTCache.CreatePivotTable(wsPT.Cells(3, 1), "TCD_1")

'----------------------------------------------------------------------

Application.DisplayAlerts = True

'----------------------------------------------------------------------

Set PT = Nothing

Set PTCache = Nothing

Set Rng = Nothing

Set wsData = Nothing

Set wb = Nothing

End Sub

RE,

Tu as un souci avec un en-tête de colonne (cellule vide !?).

Cdlt.

Re jean-Eric, toutes les en-tête de colonnes sont bien renseignées (de la cellule A3 à AN3), je ne sais pas à quoi est due cette erreur

Re,

Je persiste à dire que tu as un souci avec tes en-têtes de colonne.

Voir fichier.

ALT F8 puis exécuter la procédure.

Cdlt.

563creation-tcd-vba.xlsm (24.86 Ko)

Bonjour Jean-Eric,

il est normal que le tcd soit vide ?

P.

Re Jean Eric,

Ton fichier exemple marche, cependant j'ai fait quelques test et si le tableau fait plus de 65000 lignes, le code ne marche plus. :/

Cela me renvoie l'erreur "Erreur d'exécution '13' : Incompatibilité de type." en surlignant en jaune :

Set PTCache = wb.PivotCaches.Add(xlDatabase, Rng)

Re,

Sur quelle version Excel travailles-tu ? 2003 comme ton profil l'indique ou 2007 ?

Patrick,

Le TCD est vide car je ne sais pas quoi y mettre !...

je travaille sur 2007!

Re,

Remplace

Set PTCache = wb.PivotCaches.Add(xlDatabase, Rng)

par

Set PTCache = wb.PivotCaches.Create(xlDatabase, Rng)

Pareil, cela me fais la même erreur. :s

Ce que je ne comprends pas c'est pourquoi Excel n'accepte pas la modification du code obtenu avec l'enregistreur de macro.

Sheets.Add

ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _

"Feuil1!R3C1:R147000C40", Version:=xlPivotTableVersion12).CreatePivotTable _

TableDestination:="Feuil2!R3C1", TableName:="Tableau croisé dynamique1", _

DefaultVersion:=xlPivotTableVersion12

Sheets("Feuil2").Select

Cells(3, 1).Select

Je cherche juste à modifier

SourceData:= _

"Feuil1!R3C1:R147000C6"

Par une plage qui prendrais en compte automatiquement le tableau jusqu'à la dernière ligne. La solution que je pensais avoir trouvée était

Dim plage As Range

With Worksheets("Feuil1")

Set plage = .Range("A3:AN" & .Range("A" & Rows.Count).End(xlUp).Row)

End With

Sheets.Add

ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _

plage

Cependant je ne comprends pas pourquoi ça ne marche pas (Il n'y pas de cellule vides dans la colonne A hormis A2)

Re,

Envoie un fichier représentatif de tes données (et anonymisé si nécessaire).

Cdlt.

Re Jean-Eric, Y-a-t-il un moyen pour envoyer un fichier Excel volumineux? (le fichier est trop gros pour le forum, même en .csv)

Bonjour,

un fichier de 50 lignes devrait suffire

P.

Bonjour,

Bonjour Patrick,

Si tu dois absolument joindre un gros fichier, passe par ce lien :

http://www.cjoint.com/

Rechercher des sujets similaires à "vba creation tableau croise dynamique"