Fusion et mise en couleur ...

[fireball]

Bonjour,

j'ai une macro qui me fusionne des cellules dans laquelle je voudrai intégrer la possibilité de mise en forme (couleur) de ces cellules sans avoir à passer par une autre macro qui calcule toute ma feuille et ainsi gagner du temps.

L'idéal serait qu'à chaque fusion soit associée la mise en couleur souhaitée des cellules du style "activecell" ...


Voici ce que j'ai :
1 Macro fusion

Sub fusion()
Dim Plage As Range, I As Integer, J As Integer
Application.DisplayAlerts = False
For J = 1 To 70
For I = 2 To 900
If Cells(I, J) = Cells(I + 1, J) And Cells(I, J) <> "" Then
If Plage Is Nothing Then
Set Plage = Union(Cells(I, J), Cells(I + 1, J))
Else
Set Plage = Union(Plage, Cells(I + 1, J))
End If
Else
If Not Plage Is Nothing Then
If Plage.Count > 1 Then
Plage.Merge
Plage.Orientation = xlVertical
Set Plage = Nothing
End If
End If
End If
Next I
Next J
Application.DisplayAlerts = True
End Sub


2 Macro colorier

Sub Colorier()
Dim cell As Range, Cels As Range
Application.ScreenUpdating = False
For Each Cels In Sheets("Menu").[A8:A30] 'mon repère couleur de cellule dont l'étiquette se nomme "couleurs"
For Each cell In Range("e3:BO823")
If cell Like Cels & " *" Or Cels Like cell & "*" Then cell.Interior.ColorIndex = Cels.Interior.ColorIndex
Next
Next
End Sub


Merci du coup main !!