XL 2016 Copier plusieurs TCD sur un onglet + PDF

[FaridP]

Bonjour à tous,

J'essaye en vain de récupérer plusieurs TCD pour les copier sur un seul onglet et générer un PDF.
Je ne suis pas bien doué avec VBA et je suppose que c'est le seul moyen d'y parvenir.

Pour le 1er onglet, je souhaiterais récupérer le tableau avec les en-têtes et pour les 3 suivants, uniquement les tableaux. En parcourant le net, j'ai cru comprendre que la meilleure méthode serait de coller sous forme d'image afin de conserver la mise en page mais je ne sais pas si cette solution est pertinente ou non.

Je vous joins mon document de travail et le but est donc de retrouver les 4 TCD sur l'onglet "Base PDF" et si possible un enregistrement de ce dernier en PDF même si ce n'est pas le plus important, je devrais pouvoir m'en sortir sur ce point.

Merci à tous pour votre aide et votre temps,

Farid

 

[PMO2]

Bonjour,
Une piste avec le code suivant :

Sub aa()
Dim S As Worksheet
Dim i&
Dim Ligne&
'---
Set S = Sheets("Base PDF")
Ligne& = 1

For i& = 1 To 4
  Sheets(i&).PivotTables(1).TableRange1.Copy
  S.Paste S.Cells(Ligne&, 1)
  Ligne& = S.UsedRange.Rows.Count + 2
Next i&

Application.CutCopyMode = False
End Sub

 

[FaridP]

Bonjour PM,

Merci, c'est exactement ce que je voulais !

Je vais devoir faire quelques ajustements pour la mise en page mais j'espère m'en sortir avec l'enregistreur de macro.

Encore merci pour ton aide (enfin c'est même plus qu'une aide là).

Farid

 

[FaridP]

PM,

Je suis désolé de te déranger et je comprendrais que tu n'aies pas de temps à perdre avec ça mais j'aimerais uniquement pour le 1er onglet, récupérer aussi les 3 premières lignes du TCD (les en-têtes). J'ai essayé de greffer ça dans ton code mais ça dépasse largement mes compétences.

Dans tous les cas, tu m'as déjà beaucoup aidé.

Bonne soirée,

Farid

 

[chris]

Bonjour

Sub aa()
Dim S As Worksheet
Dim i&
Dim Ligne&
'---
Set S = Sheets("Base PDF")
Ligne& = 1

For i& = 1 To 4
    With Sheets(i&).PivotTables(1)
        IIf(i = 1, .TableRange2, .TableRange1).Copy
    End With
        S.Paste S.Cells(Ligne&, 1)
        Ligne& = S.UsedRange.Rows.Count + 2
Next i&

Application.CutCopyMode = False
End Sub

 

[PMO2]

OK, le code modifié (signalé par des ///) :

Sub aa()
Dim S As Worksheet
Dim i&
Dim Ligne&
'---
Set S = Sheets("Base PDF")
Ligne& = 1

For i& = 1 To 4

  '/// modif pmo
  If i& = 1 Then
    Sheets(i&).PivotTables(1).TableRange2.Copy
  Else
    Sheets(i&).PivotTables(1).TableRange1.Copy
  End If
  '///

  S.Paste S.Cells(Ligne&, 1)
  Ligne& = S.UsedRange.Rows.Count + 2
Next i&

Application.CutCopyMode = False
End Sub

PS : Je vois que chris t'a déjà donné la solution !!!

 

[FaridP]

Bonsoir et merci à vous 2, c'est très exactement ce dont j'avais besoin.

Je vais gérer la mise en page et l'enregistrement en PDF via l'enregistreur de macros.

Vous m'avez grandement facilité la vie !

Bonne soirée à vous,

Farid