Archiver données TCD

Bonjour, j'ai un fichier dans lequel j'importe les données de deux extractions, je réalise un tcd sur la base d'un tableau combinant des infos des deux :

Toutes les semaines je vais devoir importer de nouvelles données qui vont ecraser celles de la semaine précédente. J'aimerai "archiver" les données du tcd en les divisant par sous partie : par exemple la sous partie 3 aille dans la feuille "3", la sous partie 6 aille la feuille "6". Voici mon code test pour la sous partie 3 de mon tcd

Private Sub BoutonArchivage_Click()

  Dim FeuilleSource As Worksheet
    Dim FeuilleArchive As Worksheet
    Dim DerniereLigne As Long
    Dim Confirmation As VbMsgBoxResult
    Dim PlageSource As Range

    Confirmation = MsgBox("Êtes-vous sûr de vouloir archiver les données du TCD ?", vbYesNo + vbQuestion, "Confirmation")

    If Confirmation = vbYes Then

        Set FeuilleSource = ThisWorkbook.Sheets("TCD")

        Set FeuilleArchive = ThisWorkbook.Sheets("Archive")

        ' Définir la plage de cellules à copier depuis le TCD

        Set PlageSource = FeuilleSource.PivotTables("TCD chargeur").PivotSelect("3", xlDataAndLabel)

        DerniereLigne = FeuilleArchive.Cells(FeuilleArchive.Rows.Count, 1).End(xlUp).Row + 1

        ' Copier la plage spécifique du TCD vers la feuille d'archivage
        PlageSource.Copy Destination:=FeuilleArchive.Cells(DerniereLigne, 1)

        MsgBox ("Données archivées")
        BoutonArchivage.Enabled = False
    Else

        MsgBox ("Archivage annulé")
        Exit Sub
    End If

End Sub

Merci d'avance pour votre aide !

Bonjour,

Un essai.

Private Sub BoutonArchivage_Click()
    Dim FeuilleSource As Worksheet
    Dim FeuilleArchive As Worksheet
    Dim DerniereLigne As Long
    Dim Confirmation As VbMsgBoxResult
    Dim PlageSource As Range

    Confirmation = MsgBox("Êtes-vous sûr de vouloir archiver les données du TCD ?", vbYesNo + vbQuestion, "Confirmation")

    If Confirmation = vbYes Then
        Set FeuilleSource = ThisWorkbook.Sheets("TCD")

        ' Vérifier si la feuille d'archive existe, sinon la créer
        On Error Resume Next
        Set FeuilleArchive = ThisWorkbook.Sheets("Archive")
        On Error GoTo 0

        If FeuilleArchive Is Nothing Then
            Set FeuilleArchive = ThisWorkbook.Sheets.Add(After:=Sheets(Sheets.Count))
            FeuilleArchive.Name = "Archive"
        End If

        ' Définir la plage de cellules à copier depuis le TCD
        Set PlageSource = FeuilleSource.PivotTables("TCD chargeur").PivotSelect(3, xlDataAndLabel)

        DerniereLigne = FeuilleArchive.Cells(FeuilleArchive.Rows.Count, 1).End(xlUp).Row + 1

        ' Copier la plage spécifique du TCD vers la feuille d'archivage
        PlageSource.Copy Destination:=FeuilleArchive.Cells(DerniereLigne, 1)

        MsgBox ("Données archivées")
        BoutonArchivage.Enabled = False
    Else
        MsgBox ("Archivage annulé")
        Exit Sub
    End If
End Sub

Oiseau bleu