Matrice vers colonne

Question

Bonjour, j'aimerai "transposer" une matrice provenant d'une certaine feuille (ex :"Feuil4") vers une autre ("Feuil5") mais je n'arrive pas vraiment a faire ce que je souhaite, mon code ne me copie que la premiere ligne et s'arrête ensuite... Voici mon code et ce que je souhaiterai faire en photo :

Sub Transpose()
Dim LastLig As Long, NewLig As Long, i As Long
Dim LastCol As Integer
Dim Tablo()
With Sheets("PlanningHumain")
   LastLig = .Cells(Rows.Count, "E").End(xlUp).Row
   For i = 15 To LastLig
      LastCol = .Cells(i, Columns.Count).End(xlToLeft).Column
      ReDim Tablo(1 To LastCol)
      If LastCol = 1 Then
         Tablo(1) = .Range("A" & i)
      Else
         Tablo = Application.Transpose(.Range(.Cells(i, 1), .Cells(i, LastCol)))
      End If
      With Sheets("Feuil5")
         NewLig = .Cells(Rows.Count, "I").End(xlUp).Row + 1
         NewLig = IIf(NewLig < 4, 4, NewLig)
         .Range("I" & NewLig & ":I" & NewLig + LastCol - 1) = Tablo
      End With
      Erase Tablo
   Next i
End With

End Sub

Ce que je souhaite réaliser : (prendre les valeurs en dessous des "data" et les mettre sous forme de colonne ensuite)

("Feuil4")

vers :

("Feuil5")

Merci d'avance !

thev · Accepted Answer

Ci-dessous une proposition: Sub Transpose() Dim colonne As Range, cell As Range, tb(), i As Long For Each colonne In Feuil4.UsedRange.Columns For Each cell In colonne.Cells If IsNumeric(Mid(cell, 2, 1)) Then ReDim Preserve tb(i): tb(i) = cell.Value: i = i + 1 Next cell Next colonne Feuil5.Range("B3").Resize(UBound(tb)+1).Value = Application.Transpose(tb) End Sub...