Exraction de ligne en colonne

super ca fonctionne parfaitement merci a vous tous
par contre s'il existait un algo pourquoi pas
merci a vous 2

je n avais pas vu a ca beugue a un certain niveau
j ai reporté exactement a l'identique du tableau que j'utilise et a un moment ca ne compte plus
peux tu me dire l(erreur
merci
https://www.cjoint.com/c/LEyjwLjFMBM

bonsoir j'ai trouvé ta macro bien tard...
je l'ai adapté a mon fichier qui est en
BN122:CB130

et ma macro provoque une ligne ininterrompue en ligne 131 a gauche
c'est quoi mon erreur?
encore merci bcp
Public Sub ok()
Dim plage As Range, cel As Range
Dim k As Long, i As Long, nmax
Dim dico As Object, cle, valeur, cles, valeurs, nbcles, TA
' def plage
Set plage = Union(Range("bn123:cb123"), Range("bn125:cb126"), Range("bn127:cb127"), Range("bn129:cb129"))
' nb max apparitions
nmax = Application.WorksheetFunction.Max(plage)
' nb apparitions - liste numéros
Set dico = CreateObject("scripting.dictionary")
For k = 0 To nmax
dico.Add k, ""
For Each cel In plage
If cel.Value = k Then dico(k) = dico(k) & ";" & cel.Offset(-1, 0)
Next cel
Next k
nbcles = dico.Count
cles = dico.keys
valeurs = dico.items
Application.ScreenUpdating = False
' affichage
For k = 0 To nmax
Range("ca131").Offset(0, -k).Value = cles(k)
valeur = valeurs(k)
If valeur = "" Then
Range("ca131").Offset(1, -k).Value = ""
Else
valeur = Right(valeur, Len(valeur) - 1)
TA = Split(valeur, ";")
Range("ca131").Offset(1, -k) = UBound(TA) + 1
Range("ca131").Offset(2, -k).Resize(1 + UBound(TA)) = Application.Transpose(TA)
End If
Next k
End Sub

une macro
ce serait tellement plus simple

une macro ca irait sans doute plus vite
merci

Merci Mike, je n'avais pas vu et pas de souci pour les plates-bandes
Mais bon le demandeur est un peu inconséquent, il demande une macro alors que CCM81 lui en avait proposé une !
Cdlmnt