Option Explicit
Sub Bouton2_QuandClic()
Dim tablo As Variant
Dim tablores As Variant
Dim i As Integer
Dim t As Byte, j As Byte
Dim data As Collection
Set data = New Collection
'création d'un tableau variant
tablo = Range('a1').CurrentRegion
'on ajoute une colonne à ce tableau
ReDim Preserve tablo(1 To UBound(tablo, 1), 1 To UBound(tablo, 2) + 1)
'on concatene dans la derniere colonne du tableau les valeurs des colonnes
'précédentes en les séparant par un ';'
For i = 1 To UBound(tablo, 1)
For j = 1 To UBound(tablo, 2) - 1 'le -1 permet de ne pas concatener la colonne de résultat
If t = 0 Then
tablo(i, UBound(tablo, 2)) = tablo(i, j)
t = 1
Else
tablo(i, UBound(tablo, 2)) = tablo(i, UBound(tablo, 2)) & ';' & tablo(i, j)
End If
Next j
t = 0
Next i
'on renvoi chaque valeur concaténer de la derniere colonne à travers le filtre d'une collection
'pour supprimer les doublons
On Error Resume Next 'on gère l'erreur de clé
For i = 1 To UBound(tablo)
data.Add tablo(i, UBound(tablo, 2)), CStr(tablo(i, UBound(tablo, 2)))
Next i
On Error GoTo 0 'on annule le getionnaire d'erreur
'on renvoi en feuille 2 les éléments de la collection en utilisant la méthode split(incompatible xl97)
For i = 1 To data.Count
t = t + 1
tablores = Split(data.Item(i), ';')
For j = 0 To UBound(tablores)
Select Case j
Case 1 To 4
Sheets('feuil2').Cells(t, j + 1) = tablores(j)
Sheets('feuil2').Cells(t, j + 1) = CDbl(Sheets('feuil2').Cells(t, j + 1))
Sheets('feuil2').Cells(t, j + 1).NumberFormat = 'h:mm:ss;@'
Case Else
Sheets('feuil2').Cells(t, j + 1) = tablores(j)
End Select
Next j
Next i
End Sub