Private Sub ListBox1_Click()
Call test
End Sub
Sub test()
Application.ScreenUpdating = False
x = 0
col = 1
For i = 0 To ListBox1.ListCount - 1
If ListBox1.Selected(i) = True Then
critere = ListBox1.List(ListBox1.ListIndex, 0)
Exit For
End If
Next i
For Each Ws In ThisWorkbook.Sheets
Set cel = Ws.Cells.Find(critere, , xlValues, xlPart, xlByRows, xlNext)
If Not cel Is Nothing Then
pAddress = cel.Address
If x = 0 Then Set Nwb = Workbooks.Add
Do
x = x + 1
With Nwb.Sheets(1)
Set plage = .Range("a" & x)
End With
Ws.Range("A" & cel.Row & ":D" & cel.Row).Copy plage
Nwb.Sheets(1).Range("A:I").Columns.AutoFit
Set cel = Ws.Cells.FindNext(cel)
Loop While Not cel Is Nothing And cel.Address <> pAddress
End If
Next Ws
End Sub