Sub Extract()
Dim nfois, t, resu(), d As Object, i&, x, j, n&
nfois = 6 'modifiable
t = Sheets("Budget").[A1].CurrentRegion.Columns(9).Offset(1).Resize(, 2) 'tableau, plus rapide, au moins 2 éléments
ReDim resu(1 To nfois * UBound(t), 1 To 1) 'tableau pour le résultat, plus rapide
Set d = CreateObject("Scripting.Dictionary")
For i = 1 To UBound(t) - 1
x = t(i, 1)
If x <> "" And Not d.exists(x) Then
d(x) = ""
For j = 1 To nfois
resu(n + j, 1) = x
Next
n = n + nfois
End If
Next
'---restitution---
With Sheets("STJ").[A13] 'à adapter éventuellement
.Resize(n + 1) = resu
.Offset(n).Resize(Rows.Count - n - .Row + 1).Delete xlUp 'RAZ en dessous
End With
With Sheets("STJ").UsedRange: End With 'actualise la barre de défilement verticale
End Sub