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
Dim Col_String As Collection
Dim Tablo As Variant
Dim k As Byte
Set Col_String = New Collection
For Each Ws In ThisWorkbook.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
'--------------------------------------------------------------------------------
' Oui oui Hervé on peut faire ceci lors de Tri simple (première colonne Triée)
' Mais attention si c'est dans des codes style de mon Ultra Barbatruc,
' (Colonne de Tri Mobile)
'--------------------------------------------------------------------------------
For C = 1 To UBound(TabResult, 2)
For C2 = C + 1 To UBound(TabResult, 2)
If TabResult(2, C2) < TabResult(2, C) Then
For k = 1 To UBound(TabResult, 1) '(<= Toujours préciser la Dimension, plus lisible)
Tmp1 = TabResult(k, C2)
TabResult(k, C2) = TabResult(k, C)
TabResult(k, C) = Tmp1
Next k
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) & '#' '(<= Un Séparateur de Plus)
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;00' '(<= Manquait une Colonne)
.Column() = TabResult
End With
End With
UserForm1.Show
End Sub