USERFORM MULTISELECT BOUCLE

bonjour,

voici le code de ma listbox
Private Sub ListBox1_Click()
Sheets("impress").Range("A1").Value = UserForm1.ListBox1.Value
Unload UserForm1
Run "Module2.copie"
End Sub

bon jusque là rien d 'extraodinaire..

ensuite voici le code qui alimente mon userform


Private Sub UserForm_Initialize()
'création tableau intermédiaire des clients
Dim Table As Scripting.Dictionary
Dim I&, j&, Valide As Boolean, A As Variant
Dim nom, X, y


Sheets("PARAM").Range("ts_client").Clear

Set Table = New Scripting.Dictionary
j = 0
nom = "deb"

boucle:
If nom = "deb" Then
nom = "2007"
ElseIf nom = "2007" Then
nom = "2008"
Else: GoTo suite
End If


With Sheets(nom)

'colonne Q
X = "Quoi"
For Each A In .Range("P2:Q2" & .Range("A1").End(xlDown).Row)
'MsgBox A
'Vérifie si le nom n'est pas une erreur, n'est pas vide
'n'a pas déjà été récupéré, ou ne contient pas "clients"
Valide = True
If X = "Quoi" Then
If UCase(A) = "NON" Then
X = "NON"
Else
X = "OUI"
End If
Else
If X = "NON" Then
If IsError(A) Then
Valide = False ' on n'y met pas les valeurs d'erreur
ElseIf Len(A) = 0 Then
Valide = False
ElseIf Table.Exists(A.Value) Then
Valide = False
End If
If Valide Then
Table.Add A.Value, j: j = j + 1 'rajoute
End If
End If
X = "Quoi"
End If

Next

'colonne S non contigues

X = "Quoi"
y = ""

For Each A In .Range("P2:S2" & .Range("A1").End(xlDown).Row)
'MsgBox A
'Vérifie si le nom n'est pas une erreur, n'est pas vide
'n'a pas déjà été récupéré, ou ne contient pas "clients"
Valide = True
If X = "Quoi" Then
If UCase(A) = "NON" Then
X = "NON"
Else
X = "OUI"
End If
y = "DEUX"
ElseIf y = "DEUX" Then
y = "TROIS"
ElseIf y = "TROIS" Then
y = "QUATRE"
ElseIf y = "QUATRE" Then

If X = "NON" Then
If IsError(A) Then
Valide = False ' on n'y met pas les valeurs d'erreur
ElseIf Len(A) = 0 Then
Valide = False
ElseIf Table.Exists(A.Value) Then
Valide = False
End If
If Valide Then
Table.Add A.Value, j: j = j + 1 'rajoute
'MsgBox ("ajout de " & j)
End If
End If
X = "Quoi"
End If

Next


End With

GoTo boucle

suite:
For I = 0 To Table.Count - 1
Debug.Print Table.Keys(I)
'ComboBox1.AddItem (Table.Keys(I))
Sheets("PARAM").Cells(I + 1, 1) = Table.Keys(I)
Next I


Set Table = Nothing ' Nettoyage

Sheets("PARAM").Activate
Columns("A:A").Select
Selection.Sort Key1:=Range("A1"), Order1:=xlAscending,
Header:=xlGuess, _
OrderCustom:=1, MatchCase:úlse, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal

I = 1
Do While Sheets("PARAM").Cells(I, 1) <> ""
UserForm1.ComboBox1.AddItem (Sheets("PARAM").Cells(I, 1))
I = I + 1
Loop
Sheets("impress").Activate
'UserForm1.Show


End Sub


ensuite voici mon module 2 qui récupère la valeur mise dans la cellule A1 et
effectue une procédure bien particulière
Sub copie()
For I = Range("c65536").End(xlUp).Row To 7 Step -1
Cells(I, 1).EntireRow.Clear ' le 2 correspond au numero de colonne
Next


ligne = 2
With Sheets("2007")

For I = 1 To .[A65000].End(xlUp).Row
'MsgBox (.Cells(I, "Q"))
If (.Cells(I, "Q") = Sheets("impress").Range("A1") Or .Cells(I, "S")
= Sheets("impress").Range("A1")) And .Cells(I, "P") = "NON" Then
.Rows(I).Copy Sheets("impress").Cells(ligne + 5, 1)
ligne = ligne + 1
End If
Next
End With

With Sheets("2008")
For I = 1 To .[A65000].End(xlUp).Row
If (.Cells(I, "Q") = Sheets("impress").Range("A1") Or .Cells(I, "S") =
Sheets("impress").Range("A1")) And .Cells(I, "P") = "NON" Then
.Rows(I).Copy Sheets("impress").Cells(ligne + 5, 1)
ligne = ligne + 1
End If
Next

End With

'suppression colonnes + mise en forme
Columns("D:L").Select
Selection.Delete Shift:=xlToLeft
Columns("B").Select
Selection.Delete Shift:=xlToLeft
'Columns("k:s").Select
'Selection.Delete Shift:=xlToLeft
Range("D4").Select
ActiveCell.FormulaR1C1 = "=R[-3]C[-3]"
Range("D4").Select
With Selection.Font
.Name = "Tahoma"
.Size = 16
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
Range("A1").Select
With Selection.Font
.Name = "Arial"
.FontStyle = "Normal"
.Size = 8
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = 2
End With


Range("A7").Select


End Sub





MAINTENANT MON PROBLEME ET C'EST LA QUE JE PECHE UN PEU

j'aimerais que dans ma zone de listbox je puisse sélectionner plusieurs
ligne (ca je sais faire listbox multiselect)

mon soucis c'est: comment lui indiquer d'executer la macro (la boucle) avec,
non plus la donnée choisie en A1 mais de A1:Ai suivant le nombre d'occurence
choisi dans ma listbox.

désolé je ne peux pas mettre mon fichier sur le net car en fait ce fichier
contient des noms de clients..

MERCI D'AVANCE

MAUD (et STEFANE)

ps: j'espere avoir été claire