Bonjour Ferramarc,
Bonjour MFerrand,
voici ton fichier! A cette heure-ci, je n'ai plus le temps de finasser sur les détails! Demain!
@MFerrand : je me suis permis d'illustrer ton idée de ramener le tri à 4 colonnes afin que Ferramarc accroche ton wagon! :wink
Comme souvent, excuse-moi, hein, je me suis lancé dans le jeu 'technique' sans approfondir comme tu le fais si bien!
For y = 1 To iCol Step 3
sCol1 = Split(Columns(y).Address(ColumnAbsolute:=False), ":")(1)
sCol2 = Split(Columns(y + 1).Address(ColumnAbsolute:=False), ":")(1)
iRow = Range(sCol1 & Rows.Count).End(xlUp).Row
tTab = Range(sCol1 & "2:" & sCol2 & iRow)
For x = 1 To iRow - 1
iFlag = 0
For Z = 0 To UBound(tTabCA, 2) - 1
If Trim(LCase(tTab(x, 1))) = Trim(LCase(tTabCA(0, Z))) Then
iFlag = 1: iIdx1 = Z
Exit For
End If
Next
If iFlag = 0 Then
iIdx = iIdx + 1: iIdx1 = iIdx - 1
ReDim Preserve tTabCA(iCol, iIdx)
End If
tTabCA(0, iIdx1) = Trim(LCase(tTab(x, 1)))
tTabCA(y - 1, iIdx1) = Trim(LCase(tTab(x, 1)))
tTabCA(y, iIdx1) = tTab(x, 2)
Next
Next
Range("K2").Resize(UBound(tTabCA, 2), iCol) = WorksheetFunction.Transpose(tTabCA)
Range("U2").Resize(UBound(tTabCA, 2), iCol) = WorksheetFunction.Transpose(tTabCA)
A+