Private Sub CommandButton1_Click()
Dim NCbx As Long, NMax As Long, TDéb(1 To 8) As String, Ls As Long, _
PlgNat As Range, VNat As String, N As Long
For NCbx = 1 To 8
If Me.Controls("CheckBox" & NCbx).Value Then
NMax = NMax + 1
TDéb(NMax) = Array("Véhicule 5Cv", "Véhicule 6Cv", "BMW", "FIAT", _
"VOLVO", "MICHELIN", "Continental", "Pirelli")(NCbx - 1) & "*"
End If
Next NCbx
Application.ScreenUpdating = False
Ls = Selection.Row ' Initialement demandée
Ls = 7 ' Ligne d'entête toujours souhaitée ?
Set PlgNat = Feuil2.[A5]
Do:
VNat = PlgNat.Value
For N = 1 To NMax
If VNat Like TDéb(N) Then
PlgNat.EntireRow.Copy
Ls = Ls + 1
Feuil17.Rows(Ls).Insert
Exit For
End If
Next N
Set PlgNat = PlgNat.Offset(1)
Loop Until IsEmpty(PlgNat)
Unload Me
End Sub