Private Sub BtnChoixSite_Click()
Dim j, NouvelleLigne
Dim c As Range, Départ
Feuil2.Range("A5:H65536").ClearContents
With Feuil1.Range("A4:A2500")
Set c = .Find(CbSite.Text)
If Not c Is Nothing Then
Départ = c.Address
Do
NouvelleLigne = Feuil2.Range("A65536").End(xlUp).Row + 1
For j = 1 To 8
Feuil2.Cells(NouvelleLigne, j) = Feuil1.Cells(c.Row, j)
Next j
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> Départ
End If
End With
FrmChoix.Hide
End Sub