Bonjour groupe
j'ai une macro qui fonctionne très bien, mais j'aurais besoin que les valeurs envoyer dans les cellules soit rouge
qu'est-ce que je dois ajouter comme code à :
Sub deuxiemeTour()
Dim r As Excel.Range
Dim c As Excel.Range
For Each c In Range("D2:J2")
If c.Value <> vbNullString Then
'// Arbitrary range, change if needed
Set r = Range("A5:A57").Find(What:=c.Value, lookat:=xlWhole).Font.Color
If Not r Is Nothing Then
If WorksheetFunction.CountIf(r.EntireRow, Range("B2").Value) > 0 Then
MsgBox Range("B2").Value & " Déjà inscrit dans la semaine " & c.Value, vbExclamation, "Error"
Else
Cells(r.Row, Columns.Count).End(xlToLeft).Offset(, 1).Value = Range("B2").Value
End If
Else
MsgBox "ligne pour semaine " & c.Value & " inexistante", vbExclamation, "Error"
End If
End If
Next
Range("A2:J2").ClearContents
End Sub
j'ai une macro qui fonctionne très bien, mais j'aurais besoin que les valeurs envoyer dans les cellules soit rouge
qu'est-ce que je dois ajouter comme code à :
Sub deuxiemeTour()
Dim r As Excel.Range
Dim c As Excel.Range
For Each c In Range("D2:J2")
If c.Value <> vbNullString Then
'// Arbitrary range, change if needed
Set r = Range("A5:A57").Find(What:=c.Value, lookat:=xlWhole).Font.Color
If Not r Is Nothing Then
If WorksheetFunction.CountIf(r.EntireRow, Range("B2").Value) > 0 Then
MsgBox Range("B2").Value & " Déjà inscrit dans la semaine " & c.Value, vbExclamation, "Error"
Else
Cells(r.Row, Columns.Count).End(xlToLeft).Offset(, 1).Value = Range("B2").Value
End If
Else
MsgBox "ligne pour semaine " & c.Value & " inexistante", vbExclamation, "Error"
End If
End If
Next
Range("A2:J2").ClearContents
End Sub