Conversion colonne ligne

Option Explicit
Sub travdem()
Dim cellule As Range
Dim nomfeuille1 As String
Dim data1 As String, col As String
Dim data2 As String
Dim i As Long, pos As Byte
' pour boucler sur la colonne 1

nomfeuille1 = "Feuil1"

With Sheets(nomfeuille1)
For Each cellule In .Range("b2:b" & .Cells(Columns(2).Cells.Count, 2).End(xlUp).Row)
    If cellule.Value = "Désignation" Then
        For i = 1 To 30
            If cellule.Offset(i, 0) = "Désignation" Then Exit For
        Next i
    ' i -1 contient le nombre de lignes
        For i = 0 To i - 1
            Select Case i
                Case 0
                    .Range("d" & cellule.Row) = cellule
                Case Else
                If cellule.Offset(i, 0) <> "" Then
                    pos = InStr(1, cellule.Offset(i, 0), ":")
                    If pos > 0 Then
                        data1 = Mid(cellule.Offset(i, 0), 1, pos - 1)
                        data2 = Trim(Mid(cellule.Offset(i, 0), pos + 1, 100))
                        col = ""
                        Select Case Trim(data1)
                            Case "Code article"
                                col = "E"
                            Case "Fabricant nom (1)"
                                col = "F"
                            [COLOR="Red"]
                                 Case " nom pour identifier" 
                                col = nom de la colonne
[/COLOR]
                            Case "Fabricant ref (2)"
                                col = "i"
                        End Select
                        If col <> "" Then .Range(col & cellule.Row) = data2
                    Else
                        .Range("d" & cellule.Row) = .Range("d" & cellule.Row) & " " & cellule.Offset(i, 0)
                    End If
                End If
            End Select
        Next i
    End If
Next cellule
End With
End Sub

Case " nom pour identifier" 
col = nom de la colonne