Sub Favoris()
Dim w As Worksheet, c As Range, n%, col As Variant, p As Byte
Application.ScreenUpdating = False
Application.DisplayAlerts = False
For Each w In Worksheets
If LCase(Right(w.Name, 3)) = "bis" Then w.Delete 'RAZ
Next
For Each w In Worksheets
If w.[A1] Like "R#*C#*" Then
w.Visible = xlSheetVisible 'si la feuille a été masquée
w.Copy After:=w
ActiveSheet.Name = w.Name & " BIS"
For Each c In [A:A].SpecialCells(xlCellTypeConstants, 2)
n = Application.CountIf(c(6, 3).Resize(20), "*FAV*")
If n < 20 Then
c(25).Resize(, 25) = "" 'effacement de la dernière ligne
c(25).Resize(, 25).Copy c(6 + n).Resize(20 - n, 25)
End If
p = 0
For n = n To 1 Step -1
col = Application.Match(c(5 + n, 2), c(27).Resize(, 11), 0)
If IsNumeric(col) Then
p = p + 1
c(27, col).Resize(12).Cut
c(27, 3).Insert xlToRight
End If
Next n
c(27, 12).Resize(12).Copy c(27, p + 3).Resize(12, 10 - p) 'pour la couleur
Next c
End If
Next w
Feuil6.Activate 'CodeName de la feuille "Accueil"
End Sub