Rangement de données

Sub RangerLesChaussettes()
    Dim i As Integer, j As Integer, k
    Dim t, t2
    With Sheets("Feuil1")
        t = .Range("A2:A" & .UsedRange.Rows.Count).Resize(, 4).Value
        ReDim t2(1 To UBound(t, 1), 1 To UBound(t, 2))
        For j = 1 To UBound(t, 2)
            k = 1
            For i = 1 To UBound(t)
                If t(i, j) <> "" Then
                    t2(k, j) = t(i, j)
                    k = k + 1
                End If
            Next
        Next
    .Range("A2:A" & .UsedRange.Rows.Count).Resize(, 4).ClearContents
    .Cells(2, 1).Resize(UBound(t2, 1), UBound(t2, 2)).Value = t2
    End With
End Sub