Microsoft 365 Userform avec recherche de valeur

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Unload UserForm1
End Sub

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Target.Row < 5 Or Intersect(Target, [V:V,AA:AA]) Is Nothing Or Target(1) = "" Then Exit Sub
Dim F As Worksheet, h&
Cancel = True
Set F = Sheets("Filtre")
F.Rows("2:" & F.Rows.Count).Clear 'RAZ
Cells(Target.Row, 1).Name = "Action" 'cellule nommée
Target.Name = "Rame" 'cellule nommée
With Sheets("tampon").[C6].CurrentRegion
    .Cells(2, -1) = "=(E7=Action)*COUNTIF(H7:IV7,Rame)" 'critère
    .AdvancedFilter xlFilterCopy, .Cells(1, -1).Resize(2), F.[A1:G1] 'filtre avancé
    .Cells(2, -1) = ""
End With
With UserForm1
    h = F.[A1].CurrentRegion.Rows.Count - 1
    With .ListBox1
        .ColumnCount = 7
        .ColumnHeads = h > 0
        .ColumnWidths = "50;50;50;70;70;65;50"
        .Width = 420
        If h Then .RowSource = F.[A1].CurrentRegion.Rows(2).Resize(h).Address(External:=True) Else .RowSource = ""
    End With
    .Caption = "Filtre sur '" & [Action] & "' et '" & Target & "'"
    .Show 0 'non modal
End With
End Sub