On s'amuse !
Sub transmettre()
Dim tac(), c As Range, i%, j%
ReDim tac(4, 5)
With Worksheets("Feuil3").UsedRange
For Each c In .Cells
If c.Interior.ColorIndex <> xlColorIndexNone Then
i = i + 1
tac(0, i) = c.Address
tac(1, i) = c.Interior.Color
If i = UBound(tac, 2) Then Exit For
End If
Next c
End With
With Worksheets("Feuil1").Range("D4:H4")
For i = 1 To 5
For j = 1 To 5
If .Cells(1, i).Interior.Color = tac(1, j) Then
tac(2, j) = .Cells(1, i).Value
tac(3, j) = .Cells(1, i).Font.ColorIndex
tac(4, j) = .Cells(1, i).HorizontalAlignment
Exit For
End If
Next j
Next i
End With
With Worksheets("Feuil3")
For i = 1 To 5
With .Range(tac(0, i))
.Value = tac(2, i)
.Font.ColorIndex = tac(3, i)
.HorizontalAlignment = tac(4, i)
End With
Next i
End With
End Sub
ReBye !!