Dim intNbLigne As Double
Dim intColonne As Integer, intValCellule As Integer
For intNbLigne = 1 To Cells(65536, 1).End(xlUp).Row
For intColonne = 1 To 10
With Cells(intNbLigne, intColonne)
intOffset = 1
While .Offset(0, intOffset).Value = .Value
intOffset = intOffset + 1
Wend
If intOffset > 1 Then
Cells(intNbLigne, Cells(intNbLigne, 255).End(xlToLeft).Column + 1).Value = '(' & intOffset & ',' & .Value & ')'
Else
Cells(intNbLigne, Cells(intNbLigne, 255).End(xlToLeft).Column + 1).Value = '(' & intOffset & ',' & .Value & ')'
End If
End With
Select Case intOffset
Case Is > 1
intColonne = intColonne + intOffset - 1
End Select
Next intColonne
Next intNbLigne