Microsoft 365 Comment synthétiser des données concaténer

Sub ListerLesParcours()

Dim AireVilles As Range, AireSemaines As Range
Dim I As Integer, J As Integer
Dim LigneParcours As ListRow
Dim TabParcours As ListObject


    Set TabParcours = Sheets("Parcours").ListObjects("t_Parcours")
    Set AireVilles = Range("t_SemainesVilles[Villes]")
    Set AireSemaines = Range("t_SemainesVilles[#headers]")
    
    With TabParcours
        If .ListRows.Count > 0 Then
            .DataBodyRange.Delete
            Debug.Print .ListRows.Count
        End If
    End With
    
    For I = 1 To AireVilles.Count
        With AireVilles(I)
             For J = 2 To AireSemaines.Count
                 If .Offset(0, J - 1) <> "" Then
                 '   Debug.Print .Value & " : " & .Offset(0, J - 1) & ", " & AireSemaines(J)
                    Set LigneParcours = TabParcours.ListRows.Add
                    With LigneParcours
                         .Range(1, 1) = AireVilles(I).Value
                         .Range(1, 2) = AireSemaines(J)
                         .Range(1, 3) = AireVilles(I).Offset(0, J - 1)
                    End With
                    Set LigneParcours = Nothing
                 End If
             Next J
        End With
    Next I
    
    With Sheets("TCD parcours")
         .Activate
         .PivotTables("Tcd_Parcours").PivotCache.Refresh
    End With

    ActiveWorkbook.SlicerCaches("Segment_IT").PivotTables("Tcd_Parcours").PivotCache.Refresh

    
    Set AireVilles = Nothing:  Set AireSemaines = Nothing
    Set TabParcours = Nothing:  Set LigneParcours = Nothing
    
    


End Sub