Sub Extraction()
Const formule As String = "=SUMIF(LISTE!RC[-1]:R[@]C[-1],Bibliothèque!RC[-1],LISTE!RC:R[@]C)"
Dim DerLigneA As Long, DerLigneB As Long
Sheets("Bibliothèque").UsedRange.Clear
With Sheets("LISTE")
DerLigneA = .Cells(.Rows.Count, 1).End(xlUp).Row
.Range("A1:A" & DerLigneA).AdvancedFilter _
Action:=xlFilterCopy, _
CopyToRange:=Sheets("Bibliothèque").Range("A1"), Unique:=True
End With
With Sheets("Bibliothèque")
DerLigneB = .Cells(.Rows.Count, 1).End(xlUp).Row
.Range("B1") = "Qté"
With .Range("B2:B" & DerLigneB)
.Formula = Replace(formule, "@", DerLigneA)
.Value = .Value
End With
End With
End Sub