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 !!
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 !!
Dernière édition: