Sub test()
Dim Factive As Worksheet
Set Factive = Worksheets(ActiveSheet.Name)
Dim FGroupSemaine As Worksheet
Set FGroupSemaine = Worksheets("Groupe semaine")
Dim sh As Shape
For n = Factive.Shapes.Count To 1 Step -1
If InStr(Factive.Shapes(n).Name, "Oval") <> 0 Or InStr(Factive.Shapes(n).Name, "AutoShape") <> 0 Then
Factive.Shapes(n).Delete
End If
Next n
Dim colonnes As Variant
colonnes = Array("C", "E", "G")
For n = LBound(colonnes) To UBound(colonnes)
For m = 1 To Factive.Range(colonnes(n) & Factive.Range(colonnes(n) & 65536).End(xlUp).Row).Row
If Factive.Range(colonnes(n) & m) <> "" Then
If InStr(Factive.Range(colonnes(n) & m), "?") = 0 Then
Set c = FGroupSemaine.Cells.Find(Factive.Range(colonnes(n) & m), LookIn:=xlValues, lookat:=xlWhole)
If Not c Is Nothing Then
firstAddress = c.Address
Do
'MsgBox (c.Value & " " & c.Address)
If c.Column = 14 Then
Set sh = FGroupSemaine.Shapes("AutoShape 13")
sh.Duplicate: sh.Cut: Factive.Paste
Selection.Top = Factive.Range(colonnes(n) & m).Top
Selection.Left = Factive.Range(colonnes(n) & m).Left
End If
If c.Column = 15 Then
Set sh = FGroupSemaine.Shapes("Oval 93")
sh.Duplicate: sh.Cut: Factive.Paste
Selection.Top = Factive.Range(colonnes(n) & m).Top
Selection.Left = Factive.Range(colonnes(n) & m).Left + Factive.Range(colonnes(n) & m).Width - Selection.Width
End If
Set c = FGroupSemaine.Cells.FindNext(c)
Loop While Not c Is Nothing And c.Address <> firstAddress
End If
End If
End If
Next m
Next n
Factive.Range("A1").Select
End Sub