Private Sub CommandButton1_Click()
Dim i As Long
Dim F As Worksheet, Rw As Range
With Application: .DisplayAlerts = False: .ScreenUpdating = False: End With
On Error Resume Next
Set F = Sheets("extrait")
On Error GoTo 0
If Not F Is Nothing Then F.Delete
Sheets("bd ").Copy after:=Sheets(Sheets.Count)
Sheets(Sheets.Count).Name = "extrait"
With Sheets("extrait")
Set Rw = .Columns(1).Find("N°Entrée")
If Not Rw Is Nothing Then
.Rows(Rw.Row).Copy .Cells(1, 1)
Else
MsgBox "Pas de ligne d'en tête dans la base", 64, "Attention"
.Rows(1).Insert
End If
For i = .Cells(Rows.Count, 1).End(3).Row To 2 Step -1
If .Cells(i, 2).Value = "" Or Not IsNumeric(.Cells(i, 2).Value) Then _
.Rows(i).Delete
Next i
.Columns.AutoFit
End With
With Application: .DisplayAlerts = True: .ScreenUpdating = True: End With
End Sub