Dim DL%, T, T2, Mois, i%, j%, k%, NbTirets%, Chaine$, IndexT2%, Index%, NbPlages, Ligne%
Application.ScreenUpdating = False
[A:E].ClearContents: [A:E].Interior.Color = vbWhite ' Efface données précédentes
DL = Sheets("Données").Range("A65500").End(xlUp).Row ' Dernière ligne utile
T = Sheets("Données").Range("A2:O" & DL) ' Tranfert données dans array
Mois = Sheets("Données").Range("D1:O1") ' Tranfert mois dans array
ReDim T2(12 * DL, 5): IndexT2 = 1 ' T2 : array de sortie
For i = 1 To UBound(T)
NbTirets = 0 ' Détection ligne vide qui contient 12 tirets
For j = 4 To 15
If T(i, j) = "-" Then NbTirets = NbTirets + 1
Next j
If NbTirets < 12 Then ' Si pas ligne vide
For k = 0 To 11
T2(IndexT2 + k, 1) = T(i, 1) ' Ville
T2(IndexT2 + k, 2) = T(i, 2) ' Indice
T2(IndexT2 + k, 3) = T(i, 3) ' Libellé
T2(IndexT2 + k, 4) = Mois(1, k + 1) ' Mois
T2(IndexT2 + k, 5) = T(i, k + 4) ' Valeur
Next k
IndexT2 = IndexT2 + 12 ' Incrément index stockage ( page de 12 éléments )
End If
Next i
Range("$A$1").Resize(UBound(T2, 1), UBound(T2, 2)) = T2 ' Rangement données dans feuilles
NbPlages = Round(0.1 + Range("A65500").End(xlUp).Row / 24, 0) ' Mise en couleur par plage de 12 mois
Ligne = 1
For k = 1 To NbPlages
Range(Cells(Ligne, "A"), Cells(Ligne + 11, "E")).Interior.Color = RGB(255, 255, 200)
Range(Cells(Ligne + 12, "A"), Cells(Ligne + 24, "E")).Interior.Color = RGB(220, 255, 255)
Ligne = Ligne + 24
Next k
End Sub