Option Base 1
Public d
Sub test()
Set d = CreateObject("Scripting.dictionary")
Application.ScreenUpdating = False
For Each cel In Range("LESMOTIFS")
x = cel.Value
d(x) = cel.Interior.Color
Next
Set MonNom = ThisWorkbook
chemin = ThisWorkbook.Path
For m = 11 To 188 Step 15
For n = 0 To 12
mois = Sheets("Planning annuel").Range("A" & m)
Set aservir = Sheets("Planning annuel").Range("D" & m + n)
[COLOR="#FFFF00"] Workbooks.Open (chemin & "\" & Sheets("Planning annuel").Range("C" & m + n) & ".xlsx")[/COLOR] liste = ActiveWorkbook.Sheets(mois).Range("F4:F34")
aservir.Resize(1, 31) = Application.Transpose(liste)
ActiveWorkbook.Close
For Each cel In aservir.Resize(1, 31)
x = cel.Value
cel.Interior.Color = d(x)
cel.Value = ""
Next
Next
Next
Call recapitule
Application.ScreenUpdating = True
End Sub
Sub recapitule()
'Application.ScreenUpdating = False
'Set d = CreateObject("Scripting.dictionary")
'For Each cel In Range("LESMOTIFS")
'x = cel.Value
'd(x) = cel.Interior.Color
'Next
a = d.items
ReDim tablo(1, UBound(a))
For m = 11 To 188 Step 15
For n = 0 To 12
For p = 4 To 34
For q = LBound(a) To UBound(a) - 1
If Cells(m + n, p).Interior.Color = a(q) Then
tablo(1, q + 1) = tablo(1, q + 1) + 1
End If
Next
Next
Range("AJ" & m + n).Resize(1, UBound(a)) = ""
Range("AJ" & m + n).Resize(1, UBound(a)) = tablo
ReDim tablo(1, UBound(a))
Next
Next
'Application.ScreenUpdating = True
End Sub