Sub ventiler()
With Sheets("Feuil3")
tabdata = .Range("D1:X15").Value
End With
For i = LBound(tabdata, 1) + 1 To UBound(tabdata, 1)
For j = LBound(tabdata, 2) + 1 To UBound(tabdata, 2)
ListeProfs = Split(tabdata(i, j), " et ")
For Each prof In ListeProfs
With Sheets("Feuil1")
Set trouve = .Range("A:A").Find(prof, lookat:=xlWhole)
If Not trouve Is Nothing Then
ligne = trouve.Row
End If
Set trouve = .Rows("1:1").Find(tabdata(i, 1), lookat:=xlWhole)
If Not trouve Is Nothing Then
colonne = trouve.Column
End If
.Cells(ligne, colonne) = tabdata(1, j)
End With
Next prof
Next j
Next i
End Sub