'---------------------------------------------------------------------------------------
Sub ValidationListe()
'Hasco: 21/12/2009
'http://www.excel-downloads.com/forum/newreply.php?do=newreply&noquote=1&p=782634
'---------------------------------------------------------------------------------------
Dim plg As Range, c As Range
Dim sh As Worksheet, shDest As Worksheet
Dim i As Integer
For Each sh In Worksheets
On Error Resume Next
Set plg = sh.UsedRange.SpecialCells(xlCellTypeAllValidation)
If Not plg Is Nothing Then
If shDest Is Nothing Then
Set shDest = Sheets.Add
shDest.Range("A1:C1").Value = Array("Feuille", "Cellule", "Validation")
End If
For Each c In plg
If c.Validation.Type = xlValidateList Then
With shDest.Range("A" & Rows.Count).End(xlUp).Offset(1)
.Value = sh.Name
.Offset(, 1) = c.Address
.Offset(, 2) = Replace(c.Validation.Formula1, "=", "")
End With
End If
Next
End If
Set plg = Nothing
Next sh
End Sub