Option Explicit
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
Dim i As Integer, j As Integer, Ligne_NAM As Byte, Tableau_Split
If ActiveSheet.Name <> "DONNE" Then
With Sheets("DONNE")
On Error Resume Next
Ligne_NAM = Application.WorksheetFunction.Match(ActiveSheet.Range("A10"), .Range("C:C"), 0)
If Ligne_NAM = 0 Then
Exit Sub
Else
Application.ScreenUpdating = False
ActiveSheet.Range("B13:B28").ClearContents
For i = Ligne_NAM + 1 To 1000
If Left(.Range("C" & i), 1) <> "C" Then Exit For
Dim Position_DeuxPoints As Byte, Droite_Chaine As String, Compteur As Byte
Compteur = Compteur + 1
Position_DeuxPoints = WorksheetFunction.Search("", .Range("C" & i))
Droite_Chaine = "999 " & Right(.Range("C" & i), Len(.Range("C" & i)) - Position_DeuxPoints) ' 999 rajouté car - pour une raison inconnue - le premier élément n'est pas pris compte.
Tableau_Split = Split(Droite_Chaine)
For j = 1 To 1000 'Afin d'être sûr de couvrir tous les cas possibles, mais dès que l'élément du tableau i est vide, ça crée une erreur et ça passe plus loin
ActiveSheet.Cells(Compteur + 12, j + 1) = Tableau_Split(j)
Next j
Next i
End If
End With
End If
Range("C21:C51").Select
Selection.Replace What:=".", Replacement:=" ", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Selection.Replace What:="/", Replacement:=" ", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Selection.Replace What:="-", Replacement:=" ", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
ActiveWindow.ScrollRow = 6
ActiveWindow.ScrollRow = 1
End Sub