[COLOR="DarkSlateGray"][B]Sub toto()
Dim i, j, k, l, m
Dim oClass(1 To 12, 1 To 1), oRc(1 To 12, 1 To 1), oPuTu(1 To 12, 1 To 2), oDat(), oDat2()
For i = 1 To Cells(1, Columns.Count).End(xlToLeft).Column
If Cells(1, i).Value Like "Tableau *" Then
oDat = Range(Cells(3, i + 1), Cells(16, i + 2).End(xlUp)).Value
For j = 2 To UBound(oDat, 1)
If Not IsEmpty(oDat(j, 2)) Then
If IsNumeric(oDat(j, 2)) Then
oClass(oDat(j, 2), 1) = oDat(j, 1)
With Feuil2
For k = 1 To .Cells(1, .Columns.Count).End(xlToLeft).Column
If Not IsEmpty(.Cells(1, k)) Then
oDat2 = .Range(.Cells(5, k), .Cells(.Rows.Count, k).End(xlUp)).Resize(, .Cells(3, k).MergeArea.Count).Value
For l = 1 To UBound(oDat2, 2)
If oDat2(1, l) = "R" Then Exit For
Next l
If l <= UBound(oDat2, 2) Then
For m = 2 To UBound(oDat2, 1)
If oDat2(m, 1) = oDat(j, 1) Then Exit For
Next m
If m <= UBound(oDat2, 1) Then
oRc(oDat(j, 2), 1) = oDat2(m, l)
For l = 1 To UBound(oDat2, 2)
If oDat2(1, l) = "PU" Then Exit For
Next l
If l <= UBound(oDat2, 2) Then
oPuTu(oDat(j, 2), 1) = oDat2(m, l)
End If
For l = 1 To UBound(oDat2, 2)
If oDat2(1, l) = "TU" Then Exit For
Next l
If l <= UBound(oDat2, 2) Then
oPuTu(oDat(j, 2), 2) = oDat2(m, l)
End If
Exit For
End If
End If
End If
Next k
End With
End If
End If
Next j
End If
Next i
Range("B25:B36").Value = oClass
Range("H25:H36").Value = oRc
Range("K25:L36").Value = oPuTu
End Sub[/B][/COLOR]