Sub atelier1()
Dim F1 As Worksheet, F2 As Worksheet
Set F1 = Sheets("Base")
Set F2 = Sheets("Atelier")
Application.ScreenUpdating = False
F1.Select
Columns("B:F").Select
With Selection.Interior
.Pattern = xlNone
.TintAndShade = 0
.PatternTintAndShade = 0
End With
F2.Select
With F2
.Range("B3:AE1000").ClearContents
lig1 = F1.Cells(F1.Rows.Count, 2).End(xlUp).Row
For x = 4 To lig1
For col = 2 To 32
y = .Cells(.Rows.Count, col).End(xlUp).Row + 1
If .Cells(.Rows.Count, col).End(xlUp).Row < 28 Then
If F1.Cells(x, 3).Value = .Cells(2, col).Value Then
.Cells(y, col) = F1.Cells(x, 2)
F1.Cells(x, 2).Interior.Color = vbYellow
F1.Cells(x, 3).Interior.Color = vbYellow
End If
End If
Next col
Next x
End With
Application.ScreenUpdating = True
End Sub