Sub ListElementsColonneC()
Dim Ws As Worksheet, Ws1 As Worksheet
Dim l As Long
Dim Derlig As Long, Derlig2 As Long
Dim Dico As Object
Dim Tbl As Variant
If MsgBox("Souhaitez-vous réaliser le listing ?", _
vbQuestion + vbYesNo) = vbNo Then Exit Sub
Application.ScreenUpdating = False
Set Dico = CreateObject("Scripting.Dictionary")
Set Ws1 = ThisWorkbook.Sheets("récap")
Ws1.Cells.Clear
For Each Ws In ThisWorkbook.Sheets
If Ws.Name <> "récap" Then
If Ws.Name = "toto" Or Ws.Name = "tata" _
Or Ws.Name = "tonton" Or Ws.Name = "tutu" Then
Derlig = Ws.Range("C65536").End(xlUp).Row
Tbl = Ws.Range("C1:C" & Derlig).Value
For l = LBound(Tbl) To UBound(Tbl)
If Not Tbl(l, 1) = "" And Not Dico.exists(Tbl(l, 1)) Then Dico(Tbl(l, 1)) = Ws.Name
Next l
End If
End If
Next Ws
Derlig2 = 4 'Ws1.Range("A65536").End(xlUp).Row + 1
Ws1.Range("A" & Derlig2).Resize(Dico.Count) = Application.Transpose(Dico.keys)
Ws1.Range("B" & Derlig2).Resize(Dico.Count) = Application.Transpose(Dico.items)
Set Dico = Nothing
Set Ws1 = Nothing
Application.ScreenUpdating = True
End Sub