Private Sub Label9_Click()
Dim L As Integer, Existe As Boolean
Dim Msg1 As String, Msg2 As String
Msg1 = "": Msg2 = ""
' Prépare le message pour les colonnes
For L = 0 To ListBox3.ListCount - 1
If ListBox3.Selected(L) = True Then
Msg1 = Msg1 & ListBox3.List(L) & ", "
End If
Next L
' Enlève la dernière virgule
Msg1 = Left(Msg1, Len(Msg1) - 2)
' Prépare le message pour la feuille
For L = 0 To ListBox2.ListCount - 1
If ListBox2.Selected(L) = True Then
Msg2 = "Pour la feuille : " & ListBox2.List(L) & " "
End If
Next L
Msg1 = "Vous avez choisi la/les colonne(s) : " & Msg1
' Pose la question
If MsgBox(Msg1 & vbCrLf & Msg2 & vbCrLf & "Voulez-vous créer la liste ?" _
, vbQuestion + vbYesNo, "CHOIX CORRECTE ?") = vbNo Then Exit Sub
'pour mettre une feuille liste "neuve"
'si elle existe déjà on la supprime et on en met une autre
For N = 1 To Sheets.Count
If Sheets(N).Name = "Liste" Then
Existe = True
Application.DisplayAlerts = False
Sheets("Liste").Delete
Exit For
End If
Next N
'
Sheets.Add before:=Sheets(1)
ActiveSheet.Name = ("Liste")
Dim nom As String
nom = ListBox2.Value
'déclaration des variables
Dim Cel1 As Range, Plage1 As Range
Dim Cel2 As Range, Plage2 As Range
Dim CountTot As Integer, DerL As Integer, DerC As Byte
Application.ScreenUpdating = False
With Worksheets(nom)
For L = 0 To ListBox3.ListCount - 1
If ListBox3.Selected(L) = True Then
'Dernière ligne remplie de la colonne A
DerL = .Range("A65536").End(xlUp).Row
' Dernière colonne remplie de la dernière ligne
DerC = .Cells(DerL, 255).End(xlToLeft).Column
' Définit la colonne en cours,sélectionnée dans Listbox3
[COLOR=blue][B]Set Plage1 = .Range(.Cells(2, L + 1), .Cells(DerL, L + 1))
[/B][/COLOR] ' Définit la zone de recherche des doublons
[B][COLOR=blue]Set Plage2 = .Range(.Cells(2, 1), .Cells(DerL, DerC))
[/COLOR][/B] ' Si la cellule de la feuille Liste n'est pas vide, on incrémente la colonne
C1 = Sheets("Liste").Range("IV2").End(xlToLeft).Column
If Sheets("Liste").Cells(1, C1) <> "" Then C1 = C1 + 1
'boucle sur toutes les cellules de la plage
For Each Cel1 In Plage1
CountTot = 0
CountTot = CountTot + Application.WorksheetFunction.CountIf(Plage2, "=" & Cel1.Value)
If CountTot = 1 Then
With Sheets("Liste")
L1 = Cells(65536, C1).End(xlUp).Row + 1
' Inscrit la catégorie
.Cells(1, C1).Value = Sheets(nom).Cells(1, L + 1)
.Cells(L1, C1).Value = Cel1.Value
End With
End If
Next Cel1 'prochaine cellule de la première boucle
End If
Next L
Application.ScreenUpdating = True
End With
End Sub
