Private Sub Workbook_SheetActivate(ByVal Sh As Object)
Dim Frecap As Worksheet, F As Worksheet, i&, lig&, x$, P As Range, rc As Byte
Dim colrecap%, ligrecap&, y$, t, j As Byte
Static recap As Boolean 'mémorise la variable
Set Frecap = Feuil1 'CodeName de la feuille Récap
Set F = Feuil2 'CodeName de la feuille Prono
With Sh
If .Name Like "TAB R#*" Then
Application.ScreenUpdating = False
.Cells.Clear 'RAZ
lig = 1
x = "Course: R." & Val(Mid(.Name, 6)) & "-*"
For i = 1 To F.Cells(.Rows.Count, 2).End(xlUp).Row
If F.Cells(i, 2) Like x Then
'---copie du tableau source---
Set P = F.Range(F.Cells(i, 1), F.Cells(i + 6, 2).CurrentRegion)
rc = P.Rows.Count
P.Copy .Cells(lig, 1)
.Rows(lig + rc - 10) = "": .Cells(lig + rc - 10, 2) = "Chevaux"
'---initialisation et en-têtes des tableaux dans Récap---
If recap Then
colrecap = 6 * Val(Mid(.Name, 6)) - 5
ligrecap = Frecap.Columns(colrecap) _
.Find("", Frecap.Cells(2, colrecap), xlValues, , xlByColumns).Row
y = Trim(Mid(P(1, 2), 9, 8))
y = Replace(Replace(y, ".", ""), "-", "")
If ligrecap = 3 Then Frecap.Cells(2, colrecap) = Split(y, "C")(0)
Frecap.Cells(ligrecap, colrecap) = y
Frecap.Cells(ligrecap + 14, colrecap) = y 'tableau des arrivées
End If
'---traitement du milieu du tableau---
With .Cells(lig + 8, 1).Resize(rc - 18, 8) '2 colonnes auxiliaires G et H
.Columns(7).Resize(, P.Columns.Count - 6).Clear 'RAZ à partir de la colonne G
.Columns(3).Clear 'RAZ colonne C
.Columns(3).HorizontalAlignment = xlCenter 'centrage
t = .Value 'matrice, plus rapide
For j = 1 To rc - 18
t(j, 1) = j
t(j, 4) = Val(Replace(t(j, 4), ",", "."))
t(j, 5) = Val(Replace(t(j, 5), ",", "."))
t(j, 3) = t(j, 4) - t(j, 5)
If t(j, 3) < 0 Then
t(j, 7) = -t(j, 3)
ElseIf t(j, 3) > 0 Then 'valeurs zéro non traitées
t(j, 8) = t(j, 3)
End If
Next j
.Value = t
.Sort .Columns(7), xlAscending, Header:=xlNo 'tri des valeurs < 0
If .Cells(1, 7) <> "" Then
.Cells(1, 3).Interior.ColorIndex = 3: .Cells(1, 3).Font.ColorIndex = 6
.Cells(1, 3).Copy .Cells(rc - 16, 5)
.Cells(1, 2).Copy .Cells(rc - 17, 5)
If recap Then Frecap.Cells(ligrecap, colrecap + 1) = .Cells(1, 3): _
Frecap.Cells(ligrecap, colrecap + 2) = .Cells(1, 2)
End If
.Sort .Columns(8), xlAscending, Header:=xlNo 'tri des valeurs > 0
If .Cells(1, 8) <> "" Then
.Cells(1, 3).Interior.ColorIndex = 49: .Cells(1, 3).Font.ColorIndex = 6
.Cells(1, 3).Copy .Cells(rc - 16, 6)
.Cells(1, 2).Copy .Cells(rc - 17, 6)
If recap Then Frecap.Cells(ligrecap, colrecap + 3) = .Cells(1, 3): _
Frecap.Cells(ligrecap, colrecap + 4) = .Cells(1, 2)
End If
.Columns(7).Resize(, 2) = "" 'RAZ des colonnes auxiliaires
.Sort .Columns(1), xlAscending, Header:=xlNo 'tri dans l'ordre normal
'---mises en forme de la 1ère colonne---
With .Columns(1)
.Borders.Weight = xlThin
.Interior.ColorIndex = 16 'gris
.Font.ColorIndex = 6 'jaune
.HorizontalAlignment = xlCenter
End With
End With
'---bordures---
.Cells(lig, 2).Resize(rc, P.Columns.Count - 1).Borders.Weight = xlThin
lig = lig + rc
End If
Next i
ElseIf .Name = Frecap.Name Then
Application.ScreenUpdating = False
.[2:2,17:26].Replace "R*", "", xlWhole 'RAZ
.[3:12].ClearContents 'RAZ
recap = True
For Each Sh In Worksheets
If Sh.Name Like "TAB R#*" Then Workbook_SheetActivate Sh
Next Sh
recap = False
End If
ActiveCell.Select
With .UsedRange: End With 'actualise la barre de défilement
End With
End Sub