XL 2013 Transposer 3 colonnes

Sub test()
  Dim Ligne As Long, I As Long, Deb As Long
  Deb = Cells(1, 1).End(xlDown).Row - 1
  For I = Cells(Rows.Count, 1).End(xlUp).Row + 1 To Deb Step -1
    Debug.Print Cells(I, 1).Row
    If (I - 1 - Deb) / 3 = Int((I - 1 - Deb) / 3) Then
      If I = Deb + 1 Then
        Cells(I, 1).EntireRow.Insert
        Cells(I, 6) = "<tr>"
        Exit Sub
      End If
      Cells(I, 1).Resize(2).EntireRow.Insert
      If Cells(I + 2, 6) <> "" Then
        Cells(I + 1, 6) = "<tr>"
      End If
        Cells(I, 6) = "</tr>"
    End If
  Next I
End Sub

Sub test()
  Dim Ligne As Long, I As Long, Deb As Long
  Deb = Cells(1, 1).End(xlDown).Row - 1
  For I = Cells(Rows.Count, 1).End(xlUp).Row + 1 To 1 Step -1
    If (Cells(I, 6) = "<tr>" Or Cells(I, 6) = "</tr>") And Cells(I, 6).HasFormula = False Then
      Rows(I).Delete
    End If
  Next I
  For I = Cells(Rows.Count, 1).End(xlUp).Row + 1 To Deb Step -1
    Debug.Print Cells(I, 1).Row
    If (I - 1 - Deb) / 3 = Int((I - 1 - Deb) / 3) Then
      If I = Deb + 1 Then
        Cells(I, 1).EntireRow.Insert
        Cells(I, 6) = "<tr>"
        Exit Sub
      End If
      Cells(I, 1).Resize(2).EntireRow.Insert
      If Cells(I + 2, 6) <> "" Then
        Cells(I + 1, 6) = "<tr>"
      End If
        Cells(I, 6) = "</tr>"
    End If
  Next I
End Sub

Sub test()
  Dim Ligne As Long, I As Long, Deb As Long
  Deb = Cells(1, 1).End(xlDown).Row - 1
  For I = Cells(Rows.Count, 1).End(xlUp).Row + 1 To 1 Step -1
    If (Cells(I, 7) = "<tr>" Or Cells(I, 7) = "</tr>") And Cells(I, 7).HasFormula = False Then
      Rows(I).Delete
    End If
  Next I
  For I = Cells(Rows.Count, 1).End(xlUp).Row + 1 To Deb Step -1
    Debug.Print Cells(I, 1).Row
    If (I - 1 - Deb) / 3 = Int((I - 1 - Deb) / 3) Then
      If I = Deb + 1 Then
        Cells(I, 1).EntireRow.Insert
        Cells(I, 7) = "<tr>"
        Exit Sub
      End If
      Cells(I, 1).Resize(2).EntireRow.Insert
      If Cells(I + 2, 7) <> "" Then
        Cells(I + 1, 7) = "<tr>"
      End If
        Cells(I, 7) = "</tr>"
    End If
  Next I
End Sub

Sub test1()
  Dim Ligne As Long, Ctr As Long, Deb As Long, Tabl(), Plage As Range, C As Range, Ctr1 As Long
  Deb = Cells(1, 1).End(xlDown).Row
  Set Plage = Range("A" & Deb, Cells(Rows.Count, 1).End(xlUp)).Offset(, 6)
  Ctr = -1
  Ctr1 = 0
  Ctr = Ctr + 1
  ReDim Preserve Tabl(Ctr)
  Tabl(Ctr) = "<tr>"
  For Each C In Plage
    If C.Row = 28 Then Stop
    If Ctr1 = 2 Then
      Ctr = Ctr + 1
      ReDim Preserve Tabl(Ctr)
      Ctr1 = Ctr1 + 1
      Tabl(Ctr) = C.Value
      Ctr = Ctr + 1
      ReDim Preserve Tabl(Ctr)
      Tabl(Ctr) = "</tr>"
      Ctr = Ctr + 1
      ReDim Preserve Tabl(Ctr)
      Tabl(Ctr) = "<tr>"
      Ctr1 = 0
    Else
      Ctr = Ctr + 1
      Ctr1 = Ctr1 + 1
      ReDim Preserve Tabl(Ctr)
      Tabl(Ctr) = C.Value
    End If
  Next C
  If Ctr1 <> 0 Then
      Ctr = Ctr + 1
      ReDim Preserve Tabl(Ctr)
      Tabl(Ctr) = "</tr>"
  Else
    Tabl(Ctr) = ""
  End If
  Cells.ClearContents
  Cells(Deb, 7).Resize(UBound(Tabl)) = Application.Transpose(Tabl)
End Sub