Private Sub CommandButton1_Click()
Dim sh, tablo(), i As Byte, feuille As Worksheet, x As Integer, c As Range, j As Byte
For j = 0 To ListBox1.ListCount - 1
If ListBox1.Selected(j) = True Then
For Each sh In Array("s1", "s2", "s3")
With Sheets(sh)
For Each c In .Range("b2:b" & .Range("b65536").End(xlUp).Row)
If CStr(c) = ListBox1.List(j) Then
x = x + 1
ReDim Preserve tablo(1 To 5, 1 To x)
For i = 1 To 5
tablo(i, x) = .Cells(c.Row, i)
Next i
If ExisteFeuille(ListBox1.List(j)) = True Then
Set feuille = Sheets(ListBox1.List(j))
Else
Set feuille = Sheets.Add
feuille.Move after:=Sheets(Sheets.Count)
End If
With feuille
.Name = ListBox1.List(j)
.Cells.Clear
.Range("a1").Resize(UBound(tablo, 2), UBound(tablo, 1)) = Application.Transpose(tablo)
End With
Erase tablo
End If
Next c
End With
Next sh
End If
Next j
End Sub