Sub trans()
'récupère le nombre de lignes
nblignes = Range("A" & Rows.Count).End(xlUp).Row
'récupère le nombre de colonnes
NbMots = Range("A1").End(xlToRight).Column
'Recopie des entetes en dessous des données en passant une ligne pour séparer.. pas obligatoire
Range("A1").Resize(1, 2).Copy Destination:=Range("A" & nblignes + 1)
'pour toutes les lignes de la page active
For i = 2 To nblignes
'parcourt les x colonnes contenant les mots
For j = 2 To NbMots
'on colle les data sous les données d'origine
If Cells(i, j) <> "" Then
With ActiveSheet
.Range("A" & Rows.Count).End(xlUp).Offset(1, 0) = Cells(i, 1)
.Range("B" & Rows.Count).End(xlUp).Offset(1, 0) = Cells(i, j)
End With
End If
Next j
Next i
'puis on supprime les données initiales, pour faire remonter les données réorganisées en haut..
Rows(1 & ":" & nblignes).Delete
End Sub