Sub toto()
l1 = 3
c1 = 21
c2 = 22
first_line = 3
last_line = Cells(65536, 22).End(xlUp).Row
For l1 = first_line To last_line
If Trim(Cells(l1, c1)) <> "" Then
'raz
c3 = 22
With Range(Cells(l1, 23), Cells(l1, 28))
.ClearContents
.Interior.ColorIndex = xlNone
End With
txt1 = Split(Cells(l1, c1), ";", 3)
txt3 = Split(Cells(l1, c1))
txt4 = Split(Cells(l1, c2))
tmp = Replace(Cells(l1, c2), ";", " ;") & " ; ; ;"
txt2 = Split(tmp, "; ", 3)
'référence 1
c3 = c3 + 1: Cells(l1, c3) = txt1(0)
c3 = c3 + 1
If Trim(txt2(0)) = "" Then
Cells(l1, c3 - 1).Interior.ColorIndex = 6
Else
Cells(l1, c3) = CDate(txt2(0))
Cells(l1, c3 - 1).Interior.ColorIndex = xlNone
End If
'référence 2
If UBound(txt1) > 0 Then
c3 = c3 + 1: Cells(l1, c3) = txt1(1)
c3 = c3 + 1
If Trim(txt2(1)) = "" Then
Cells(l1, c3 - 1).Interior.ColorIndex = 6
Else
Cells(l1, c3) = CDate(txt2(1))
Cells(l1, c3 - 1).Interior.ColorIndex = xlNone
End If
End If
'référence(s) suivante(s)
If UBound(txt1) > 1 Then
c3 = c3 + 1: Cells(l1, c3) = txt1(2)
' c3 = c3 + 1: Cells(l1, c3) = Mid(txt2(2), 1, Len(txt2(2)) - 6)
c3 = c3 + 1:
tmp = Replace(txt2(2), " ;", "")
tmp = Replace(tmp, " ", "")
tmp = Replace(tmp, ";", "; ")
If Len(tmp) < 8 Then tmp = ""
Cells(l1, c3) = tmp
If UBound(txt3) <> UBound(txt4) Then
Cells(l1, c3 - 1).Interior.ColorIndex = 6
Else
Cells(l1, c3 - 1).Interior.ColorIndex = xlNone
End If
End If
End If
Next
End Sub