Transposer colonne en ligne

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
  Dim i As Long, dl As Long, col As Integer, lig As Long
  dl = Cells(1, Columns.Count).End(xlToLeft).Column 'Range("A" & Rows.Count).End(xlUp).Row
  col = 1: lig = 5
  For i = 1 To dl
    If Cells(1, i).Value Like "*Parcelle*" Then
      lig = lig + 1: col = 1
    Else
      Cells(lig, col).Value = Cells(1, i).Value
      col = col + 1
    End If
    Cells(1, i).Value = ""
  Next
End Sub

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
  Dim i As Long, dl As Long, col As Integer, lig As Long 'déclaration des variables
  dl = Range("A" & Rows.Count).End(xlUp).Row 'dernière ligne de la colonne A
  col = 2: lig = 2
  For i = 1 To dl 'boucle qui analyse toutes les cellules de la colonne A
    If Cells(i, 1).Value Like "*Parcelle*" Then 'recherche si il y a le mot Parcelle
      lig = lig + 1: col = 2 ' si oui ajout d'une ligne, colonne remis à 2
    Else             'si pas de mot Parcelle
      Cells(lig, col).Value = Cells(i, 1).Value 'la cellule correspondant à la valeur lig et la colonne col reprend la valeur de la cellule analysée
      col = col + 1 'on augmente la colonne de 1
    End If 'fin de la condition
    Cells(i, 1).Value = "" 'on efface la cellule analysée
  Next 'fin de la boucle
End Sub