Bonjour,
Une autre proposition !?
Cdlt.
Option Explicit
Public Sub ArchiveData()
Dim wsPT As Worksheet, wsData As Worksheet
Dim pt As PivotTable
Dim rngPT As Range, Cell As Range
Dim n As Double
Dim a, b
a = Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12)
b = Array(3, 5, 8, 12, 17, 23, 30, 38, 47, 57, 68, 80)
Set wsPT = Worksheets("Archiv_DI")
Set pt = Worksheets("TCD_DI").PivotTables(1)
Set wsData = Worksheets("Archiv_DI")
Set rngPT = pt.TableRange1
n = Application.Match(pt.RowRange.Count - 2, a, 0)
Set Cell = wsData.Cells(b(n - 1), 4)
rngPT.Offset(2).Resize(rngPT.Rows.Count - 2).Copy
Cell.PasteSpecial xlPasteValuesAndNumberFormats
Application.CutCopyMode = 0
End Sub