Bon j'ai encore un soucis...
Le code marche parfaitement sauf que comme le fichier est xlsm, je ne peux pas utiliser le tableau créé dans un flow power automate par exemple.
Du coup j'ai essayé de l'adapter pour enregistrer le tableau sur un fichier xlsx déjà existant (feuille: Sheet1).
Cela fonctionne bien mais s'il y a des chose déjà présente sur cette feuille, je n'arrive pas cleaner la feuille avant de faire la copie.
Si j'essaye de mettre un cells.clear sur son contenu avant de faire la copie, j'ai à nouveau l'erreur "pastespecial method...."
Voici mon code:
Option Explicit
Sub CreateEmailList()
' Constants
Const swsName As String = "Filter"
Const dFilePath As String = "https://xxxxxxxxxxxx/Shared%20Documents/Commercial/Informations%20Clients/_Gestion%20des%20Besoins%20QC/Liste%20emails.xlsx"
Const dwsName As String = "Sheet1"
Const dfCol As String = "A"
' Source
Dim wb As Workbook
Dim ws As Worksheet
Dim pvt As PivotTable
Dim stbl As ListObject
Dim rng As Range
Set wb = ThisWorkbook
With wb
Set ws = wb.Worksheets(swsName)
Set pvt = ws.PivotTables("PivotTable1")
pvt.RepeatAllLabels (xlRepeatLabels)
Set rng = IIf(pvt.RowGrand = False, pvt.TableRange1, pvt.TableRange1.Resize(pvt.TableRange1.Rows.Count - 1))
rng.Copy
End With
Application.ScreenUpdating = False
' Destination
Dim dwb As Workbook
Dim dws As Worksheet
Dim tbl As ListObject
Set dwb = Workbooks.Open(dFilePath)
Set dws = dwb.Worksheets(dwsName)
With dws
For Each tbl In .ListObjects
tbl.Unlist
Next
.Range("A1").PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
.ListObjects.Add(xlSrcRange, .Range("A1").CurrentRegion, , xlYes).Name = "T_Mail"
.ListObjects("T_Mail").TableStyle = "TableStyleLight13"
End With
dwb.Close SaveChanges:=True
pvt.RepeatAllLabels (xlDoNotRepeatLabels)
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub