extraire

Private Sub CommandButton1_Click()
Dim i As Long
Dim F As Worksheet
Application.DisplayAlerts = False
Application.ScreenUpdating = False
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")
    Sheets("bd ").Rows(11).Copy .Cells(1, 1)
    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
End With
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

=SI(LIGNES($2:2)<=SOMME(N(ESTNUM(Col_A)));INDEX(Col_A;PETITE.VALEUR(SI(ESTNUM(Col_A);LIGNE(INDIRECT("1:"&LIGNES(Col_A))));LIGNES($2:2)));"")

=SI(OU($A2="";COLONNE()>31);"";RECHERCHEV($A2;DECALER(Col_A;;;;COLONNE());COLONNE();0))

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