XL 2010 VBA Copier une validation de cellule

Guy_M

XLDnaute Occasionnel
Bonjour,
Je copie les valeurs et les formats d'une feuille (source) dans une autre (Destination) et je souhaite conserver les validations des cellules. J'ai donc tenté ce petit bout de code
VB:
    With FeuilDest
        FeuilSource.Cells.Copy
        'L'ordre du collage doit être respecté pour pouvoir coller des nombres au format texte
        .Cells.PasteSpecial xlPasteValuesAndNumberFormats
        .Cells.PasteSpecial xlPasteFormats 'Collage du format
    End With
    For Each CellSource In FeuilSource.Cells.SpecialCells(xlCellTypeAllValidation)
        Set CellDest = FeuilDest.Range(CellSource.Address)
        With CellDest.Validation
            .Delete
            .Add Type:=CellSource.Validation.Type, _
                 AlertStyle:=CellSource.Validation.AlertStyle, _
                 Operator:=CellSource.Validation.Operator, _
                 Formula1:=CellSource.Validation.Formula1, _
                 Formula2:=CellSource.Validation.Formula2
            .ErrorMessage = CellSource.Validation.ErrorMessage
            .ErrorTitle = CellSource.Validation.ErrorTitle
            .IgnoreBlank = CellSource.Validation.IgnoreBlank
            .IMEMode = CellSource.Validation.IMEMode
            .InCellDropdown = CellSource.Validation.InCellDropdown
            .InputMessage = CellSource.Validation.InputMessage
            .InputTitle = CellSource.Validation.InputTitle
            .ShowError = CellSource.Validation.ShowError
            .ShowInput = CellSource.Validation.ShowInput
        End With
    Next CellSource

Malheureusement, j'ai une erreur "1004" sur ".add Type:=". Cela semble fréquent avec Validation.Add. Y a-t-il quelque chose que j'aurais loupé là dedans ?

J'ai essayé plein de solutions dont un Select Case sur CellSource.Validation.Type car le nombre de paramètre de .add semle varier suivant la valeur de Type. En désespoir de cause, j'ai écrit un contournement

Code:
    For Each CellSource In FeuilSource.Cells.SpecialCells(xlCellTypeAllValidation)
        Set CellDest = FeuilDest.Range(CellSource.Address)
        CellSource.Copy CellDest
        If Not CellSource.value = "" Then
            CellSource.Copy
            CellDest.PasteSpecial Paste:=xlPasteValues
        Else
            CellDest.Formula = ""
        End If
    Next CellSource

Par avance, je vous remercie de vos réponses, sinon j'espère que ce bout code sera utile à quelqu'un.

A bientôt
GM
 

Discussions similaires