Sub Transfert()
Dim TabTemp As Variant
Dim TabResult() As Variant
Dim DerLgn As Integer, L As Integer, x As Integer
Dim Dercol As Byte, C As Integer, C2 As Integer
Dim Ws As Worksheet
Dim MyString As String
Dim Tmp1 As String, Tmp2 As Variant, Tmp3 As Variant, Tmp4 As String, Tmp5 As Variant, Tmp6 As Variant
Dim Tmp7 As String, Tmp8 As Variant, Tmp9 As Variant, Tmp10 As String, Tmp11 As Variant
Dim Col_String As Collection
Dim Tablo As Variant
Set Col_String = New Collection
For Each Ws In Worksheets
If Ws.Name = 'Feuil1' Or Ws.Name = 'Feuil3' Then
With Ws
DerLgn = .Range('A65536').End(xlUp).Row
TabTemp = .Range(.Cells(2, 1), .Cells(DerLgn, 11)).Value
For L = 1 To UBound(TabTemp, 1)
x = x + 1
ReDim Preserve TabResult(11, x)
For C = 1 To UBound(TabTemp, 2)
TabResult(C, x) = TabTemp(L, C)
Next C
Next L
End With
End If
Next
For C = 1 To UBound(TabResult, 2)
For C2 = C + 1 To UBound(TabResult, 2)
If TabResult(2, C2) < TabResult(2, C) Then
Tmp1 = TabResult(1, C2): Tmp2 = TabResult(2, C2): Tmp3 = TabResult(3, C2): Tmp4 = TabResult(4, C2)
Tmp5 = TabResult(5, C2): Tmp6 = TabResult(6, C2): Tmp7 = TabResult(7, C2): Tmp8 = TabResult(8, C2)
Tmp9 = TabResult(9, C2): Tmp10 = TabResult(10, C2): Tmp11 = TabResult(11, C2)
TabResult(1, C2) = TabResult(1, C): TabResult(2, C2) = TabResult(2, C): TabResult(3, C2) = TabResult(3, C)
TabResult(4, C2) = TabResult(4, C): TabResult(5, C2) = TabResult(5, C): TabResult(6, C2) = TabResult(6, C)
TabResult(7, C2) = TabResult(7, C): TabResult(8, C2) = TabResult(8, C): TabResult(9, C2) = TabResult(9, C)
TabResult(10, C2) = TabResult(10, C): TabResult(11, C2) = TabResult(11, C)
TabResult(1, C) = Tmp1: TabResult(2, C) = Tmp2: TabResult(3, C) = Tmp3
TabResult(4, C) = Tmp4: TabResult(5, C) = Tmp5: TabResult(6, C) = Tmp6
TabResult(7, C) = Tmp7: TabResult(8, C) = Tmp8: TabResult(9, C) = Tmp9
TabResult(10, C) = Tmp10: TabResult(11, C) = Tmp11
End If
Next
Next
On Error Resume Next
For C = 1 To UBound(TabResult, 2)
MyString = TabResult(1, C) & '#' & TabResult(2, C) & '#' & TabResult(3, C) & '#' & TabResult(4, C) & '#' & _
TabResult(5, C) & '#' & TabResult(6, C) & '#' & TabResult(7, C) & '#' & TabResult(8, C) & '#' & TabResult(9, C) & '#' & _
TabResult(10, C) & '#' & TabResult(11, C)
Col_String.Add MyString, CStr(MyString)
Next
On Error GoTo 0
Err.Clear
With Worksheets('Feuil4')
.Range('A2:K700').ClearContents
For L = 1 To Col_String.Count
DerLgn = .Range('A65536').End(xlUp).Row + 1
Tablo = Split(Col_String(L), '#')
.Cells(DerLgn, 1).Resize(1, UBound(Tablo, 1)) = Tablo
Next L
ReDim Preserve TabResult(11, DerLgn)
TabResult() = Application.Transpose(.Range('A2:K' & DerLgn).Value)
With UserForm1.pascal
.ColumnCount = 11
.ColumnWidths = '00;118;118;00;00;118;00;00;00;00'
.Column() = TabResult
End With
End With
UserForm1.Show
End Sub