Boucle appel de fonction

[Hoareau]

Bonjour

Je dois appeller la fonction ListeValUniques dans une boucle
soir 3 colonnes sur 1000 lignes environ
Elle prendre les valeurs uniques et les transpose en ligne
Je cherche a faire une boucle qui appelle la fonction pour les x lignes d'avant
X doit être un paramêttr modifiable.
y nombre colonnes doit être modifiable
Sur chaque ligne les valeurs uniques des lignes d'avant
merci



'Pour plus de colonnes
'Changer la plage
'Changer la valeur de PlageSrc.Columns.Count > 1
'qui doit correspondre au nombre de colonne de la plage

Sub test()

For N = 1 To 100
For col = 1 To 3

ListeValUniques Range("A" & N & ":c" & N + 10), Range("E" & N)

Next
Next

'ListeValUniques Range("A1:c11"), Range("E1") >> original

End Sub



Sub ListeValUniques(PlageSrc As Range, CellDest As Range)
'Extrait les valeurs uniques d'une colonne et les renvoie
'dans une autre, à partir de CellDest
Dim Arr1, Elt, Arr2(), Coll As New Collection

If PlageSrc.Columns.Count > 3 Then Exit Sub
Arr1 = PlageSrc.Value

For Each Elt In Arr1
On Error Resume Next
Coll.Add Elt, CStr(Elt)
If Err.Number = 0 Then
ReDim Preserve Arr2(1 To Coll.Count)
Arr2(Coll.Count) = Elt
End If
On Error GoTo 0
Next

CellDest.Resize(Coll.Count).Value = _
Application.Transpose(Arr2)

'Ajout pour transposer en ligne et non en colonne

With Range("E1", Range("e1").End(xlDown))
.Select
.Copy
End With

[f1].Select

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True

End Sub