Jean -Eric, j'ai réussi à mettre le module mais j'ai message erreur 9
Public Sub Create_PT_2()
Dim wb As Workbook
Dim wsData As Worksheet, wsPT As Worksheet
Dim tbl As Variant, Arr() As Variant
Dim lo As ListObject
Dim PTCache As PivotCache, PT As PivotTable
Dim pf As PivotField
Dim lastCol As Long, lastRow As Long, lRow As Long
Dim I As Long, k As Long
With Application
.DisplayAlerts = False
.ScreenUpdating = False
End With
Set wb = ThisWorkbook
Set wsData = wb.Worksheets("Feuil1")
lRow = 6: k = 1
With wsData
lastCol = .Cells(6, .Columns.Count).End(xlToLeft).Column
lastRow = .Cells(.Rows.Count, 2).End(xlUp).Row
tbl = .Cells(7, 2).Resize(lastRow - lRow, lastCol).Value
End With
For I = LBound(tbl) To UBound(tbl)
If tbl(I, 4) <> "" Then
ReDim Preserve Arr(1 To UBound(tbl), 4)
Arr(k, 0) = tbl(I, 1)
Arr(k, 1) = CDate(tbl(I, 3))
Arr(k, 2) = tbl(I, 7)
Arr(k, 3) = tbl(I, 15)
k = k + 1
End If
Next I
On Error Resume Next
wb.Worksheets("TCD 2").Delete
On Error GoTo 0
Application.DisplayAlerts = True
Set wsPT = wb.Worksheets.Add
wsPT.Name = "TCD 2"
With wsPT
.Cells(1).Resize(, 4).Value = Array("Dépt.", "Date", "Client", "Quantité")
.Cells(2, 1).Resize(UBound(Arr, 1), UBound(Arr, 2)).Value = Arr
Set lo = .ListObjects.Add(xlSrcRange, .Cells(1).CurrentRegion, , xlYes)
With lo
.Name = "tableau1"
.TableStyle = "TableStyleLight11"
End With
End With
Set PTCache = wb.PivotCaches.Create(xlDatabase, lo.Range)
Set PT = PTCache.CreatePivotTable(wsPT.Cells(1, 6), "PT_2")
With PT
.ManualUpdate = True
.AddFields RowFields:=Array("Dépt.", "Client"), ColumnFields:="Date"
With .PivotFields("Quantité")
.Orientation = xlDataField
.Function = xlCount
.NumberFormat = "#,##0;[Red]-#,##0;"
.Caption = "NB quantité"
End With
.RowAxisLayout xlTabularRow
.TableStyle2 = "PivotStyleMedium6"
For Each pf In .RowFields
pf.Subtotals(1) = True
pf.Subtotals(1) = False
Next pf
.ManualUpdate = False
End With
End Sub