recherche de police de la meme couleur

Sub b()
Dim ep1, t$, vert&, c As Range
ep1 = MsgBox("On recherche la police en Vert?", vbQuestion + vbYesNo, "Test 1")
If ep1 = vbYes Then
With Sheets(1)
vert = [E11].Font.ColorIndex
    For Each c In .UsedRange
        If c.Font.ColorIndex = vert Then
        t = t & c & " : " & c.Address(0, 0) & vbLf
        End If
    Next c
End With
MsgBox Left(t, Len(t) - 1), vbInformation, "Résultats"
Else
End
End If
End Sub

[COLOR=blue]Private Sub[/COLOR] CommandButton1_Click()
Application.ScreenUpdating = [COLOR=blue]False[/COLOR]
[COLOR=blue]Set[/COLOR] mondico = CreateObject("Scripting.Dictionary")
Derligne = [a65000].End(xlUp).Row
Dercol = Cells(2, Application.Columns.Count).End(xlToLeft).Column - 2
Sheets("demande interim").Cells.Delete
[COLOR=blue]For[/COLOR] j = 5 [COLOR=blue]To[/COLOR] Dercol [COLOR=blue]Step[/COLOR] 7
    [COLOR=blue]Set[/COLOR] plg = Range(Cells(2, j), Cells(Derligne, j))
    [COLOR=blue]For Each[/COLOR] c [COLOR=blue]In[/COLOR] plg
        [COLOR=blue]If[/COLOR] c.Font.ColorIndex <> -4105 [COLOR=blue]Then[/COLOR] mondico.Item(c.Font.ColorIndex) = c.Font.ColorIndex
    [COLOR=blue]Next[/COLOR] c
    Temp = mondico.Items
    [COLOR=blue]For[/COLOR] k = 0 [COLOR=blue]To UBound[/COLOR](Temp)
        z = 0
        [COLOR=blue]ReDim[/COLOR] Temp2(0 [COLOR=blue]To[/COLOR] Derligne, 1 [COLOR=blue]To[/COLOR] 3)
        [COLOR=blue]For Each[/COLOR] c [COLOR=blue]In[/COLOR] plg
            [COLOR=blue]If[/COLOR] c.Font.ColorIndex = Temp(k) [COLOR=blue]And[/COLOR] c.Value <> "" [COLOR=blue]Then[/COLOR]
                Temp2(z, 1) = Cells(1, j - 4).Value
                Temp2(z, 2) = c.Value
                Temp2(z, 3) = c.Offset(0, 1).Value
                z = z + 1
            [COLOR=blue]End If[/COLOR]
        [COLOR=blue]Next[/COLOR] c
        [COLOR=blue]If[/COLOR] z <> 0 [COLOR=blue]Then[/COLOR]
            [COLOR=blue]With[/COLOR] Sheets("demande interim")
                Lrow = .Cells(Rows.Count, "A").End(xlUp).Row + 1
                [COLOR=blue]If[/COLOR] .Cells(1, 1) = "" [COLOR=blue]Then[/COLOR] Lrow = 1
                [COLOR=blue]With[/COLOR] .Cells(Lrow, 1).Resize([COLOR=blue]UBound[/COLOR](Temp2), 3)
                    .Value = Temp2
                    .Font.ColorIndex = Temp(k)
                [COLOR=blue]End With[/COLOR]
            [COLOR=blue]End With[/COLOR]
        [COLOR=blue]End If[/COLOR]
    [COLOR=blue]Next[/COLOR] k
[COLOR=blue]Next[/COLOR] j
Sheets("demande interim").Activate
Application.ScreenUpdating = [COLOR=blue]True[/COLOR]
[COLOR=blue]End Sub[/COLOR]

[COLOR=blue]Private Sub[/COLOR] CommandButton1_Click()
Application.ScreenUpdating = [COLOR=blue]False[/COLOR]
w = 4
[COLOR=blue]Set[/COLOR] mondico = CreateObject("Scripting.Dictionary")
Derligne = [a65000].End(xlUp).Row
Dercol = Cells(2, Application.Columns.Count).End(xlToLeft).Column - 2
[COLOR=blue]For[/COLOR] i = 4 [COLOR=blue]To[/COLOR] 99 [COLOR=blue]Step[/COLOR] 19
    Sheets("demande interim").Rows(i).ClearContents
[COLOR=blue]Next[/COLOR] i
[COLOR=blue]For[/COLOR] j = 5 [COLOR=blue]To[/COLOR] Dercol [COLOR=blue]Step[/COLOR] 7
    [COLOR=blue]Set[/COLOR] plg = Range(Cells(2, j), Cells(Derligne, j))
    [COLOR=blue]For Each[/COLOR] c [COLOR=blue]In[/COLOR] plg
        [COLOR=blue]If[/COLOR] c.Font.ColorIndex <> -4105 [COLOR=blue]And[/COLOR] c.Value <> "" [COLOR=blue]Then[/COLOR] mondico.Item(c.Font.ColorIndex) = c.Font.ColorIndex
    [COLOR=blue]Next[/COLOR] c
    Temp = mondico.Items
    [COLOR=blue]For[/COLOR] k = 0 [COLOR=blue]To UBound[/COLOR](Temp)
        z = 0
        [COLOR=blue]ReDim[/COLOR] Temp2(0 [COLOR=blue]To[/COLOR] Derligne, 1 [COLOR=blue]To[/COLOR] 3)
        [COLOR=blue]For Each[/COLOR] c [COLOR=blue]In[/COLOR] plg
            [COLOR=blue]If[/COLOR] c.Font.ColorIndex = Temp(k) [COLOR=blue]And[/COLOR] c.Value <> "" [COLOR=blue]Then[/COLOR]
                Temp2(z, 1) = Cells(1, j - 4).Value
                Temp2(z, 2) = c.Value
                Temp2(z, 3) = c.Offset(0, 1).Value
                z = z + 1
            [COLOR=blue]End If[/COLOR]
        [COLOR=blue]Next[/COLOR] c
        [COLOR=blue]With[/COLOR] Sheets("demande interim")
            [COLOR=blue]For[/COLOR] i = [COLOR=blue]LBound[/COLOR](Temp2) [COLOR=blue]To UBound[/COLOR](Temp2)
                [COLOR=blue]If[/COLOR] Temp2(i, 3) = "" [COLOR=blue]Then[/COLOR]
                    .Cells(w, 1) = Temp2(i, 2)
                [COLOR=blue]Else[/COLOR]
                    .Cells(w, 5) = Temp2(i, 2)
                    .Cells(w, 6) = "En " & Temp2(i, 3)
                    .Cells(w, 3) = "en remplacement de "
                [COLOR=blue]End If[/COLOR]
            [COLOR=blue]If[/COLOR] .Cells(w, 1) <> "" [COLOR=blue]And[/COLOR] .Cells(w, 5) <> "" [COLOR=blue]Then[/COLOR] w = w + 19
            [COLOR=blue]Next[/COLOR] i
        [COLOR=blue]End With[/COLOR]
    [COLOR=blue]Next[/COLOR] k
    mondico.RemoveAll
[COLOR=blue]Next[/COLOR] j
Application.ScreenUpdating = [COLOR=blue]True[/COLOR]
[COLOR=blue]End Sub[/COLOR]

[COLOR=blue]Private Sub[/COLOR] CommandButton1_Click()
[COLOR=blue]Set[/COLOR] F1 = ActiveSheet
[COLOR=blue]Set[/COLOR] F2 = Sheets("demande interim")
[COLOR=blue]Set[/COLOR] mondico = CreateObject("Scripting.Dictionary")
w = 4
[COLOR=blue]For[/COLOR] i = 4 [COLOR=blue]To[/COLOR] 156 [COLOR=blue]Step[/COLOR] 19
    F2.Rows(i).ClearContents
[COLOR=blue]Next[/COLOR] i
[COLOR=blue]With[/COLOR] F1
    Derligne = .Cells(Rows.Count, 1).End(xlUp).Row
    Dercol = .Cells(2, Columns.Count).End(xlToLeft).Column - 2
    [COLOR=blue]For[/COLOR] j = 5 [COLOR=blue]To[/COLOR] Dercol [COLOR=blue]Step[/COLOR] 7
        [COLOR=blue]Set[/COLOR] plg = .Range(Cells(3, j), Cells(Derligne, j))
        [COLOR=blue]For Each[/COLOR] c [COLOR=blue]In[/COLOR] plg
            [COLOR=blue]If[/COLOR] c.Font.ColorIndex <> -4105 [COLOR=blue]And[/COLOR] c.Value <> "" [COLOR=blue]Then[/COLOR] mondico.Item(c.Font.ColorIndex) = c.Font.ColorIndex
        [COLOR=blue]Next[/COLOR] c
        [COLOR=blue]For Each[/COLOR] k [COLOR=blue]In[/COLOR] mondico.Keys
            [COLOR=blue]ReDim[/COLOR] Temp(1 [COLOR=blue]To[/COLOR] 6)
            [COLOR=blue]For Each[/COLOR] c [COLOR=blue]In[/COLOR] plg
                [COLOR=blue]If[/COLOR] c.Font.ColorIndex = mondico(k) [COLOR=blue]And[/COLOR] c.Value <> "" [COLOR=blue]Then[/COLOR]
                    [COLOR=blue]If[/COLOR] c.Offset(0, 1).Value = "" [COLOR=blue]Then[/COLOR]
                        Temp(1) = c.Value
                        Temp(3) = "en remplacement de "
                    [COLOR=blue]Else[/COLOR]
                        Temp(5) = c.Value
                        Temp(6) = "En " & c.Offset(0, 1).Value
                    [COLOR=blue]End If[/COLOR]
                [COLOR=blue]End If[/COLOR]
            [COLOR=blue]Next[/COLOR] c
            F2.Cells(w, 1).Resize([COLOR=blue]LBound[/COLOR](Temp), [COLOR=blue]UBound[/COLOR](Temp)) = Temp
            w = w + 19
        [COLOR=blue]Next[/COLOR] k
        mondico.RemoveAll
    [COLOR=blue]Next[/COLOR] j
[COLOR=blue]End With[/COLOR]
F2.Activate
[COLOR=blue]End Sub[/COLOR]