Sub Courses()
Dim w As Worksheet, c As Range, course$, c1 As Range, c2 As Range
Application.ScreenUpdating = False
Application.DisplayAlerts = False
For Each w In Worksheets
If LCase(Right(w.Name, 3)) = "fav" 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
For Each c In w.[A:A].SpecialCells(xlCellTypeConstants, 2)
'---RAZ---
c(1, 2).Resize(4) = ""
c(25, 2).Resize(, 23) = ""
c(25, 2).Resize(, 23).Copy c(6, 2).Resize(19) 'tableau du haut
c(26, 12).Resize(13).Copy Union(c(26, 3).Resize(, 9), c(26, 19).Resize(, 6)) 'tableau du bas
'---copie la feuille PRONO---
course = "Course: R." & Val(Mid(c, 2)) & "-C." & Mid(c, InStr(c, "C") + 1)
With Sheets("PRONO")
Set c1 = .[B:B].Find(course, , xlValues, xlPart)
If Not c1 Is Nothing Then
c(1, 2).Resize(4) = c1.Resize(4).Value
Set c2 = .[B:B].Find("Rang", c1)
c1(5).Resize(c2.Row - c1.Row - 4, 23).Copy c(5, 2) 'tableau du haut
c2.Resize(12, 23).Copy c(26, 2) 'tableau du bas
End If
End With
Next c
End If
Next w
End Sub