Sélectionner plusieurs plages de cellules discontinues

Bonjour au forum,

J'ai besoin pour un fichier de pouvoir effacer et déverrouiller plusieurs plages de cellules discontinues.

Voici mon code :

Dim ws As Worksheet

    For Each ws In Worksheets
           If Not ws.Name Like "Statistiques" Then
                ws.Unprotect "mdp"
                ws.Range("B18:C161,I18:W161,F34:F35,F30:F31,F26:F27,F22:F23,F18:F19,F158:F159,F154:F155,F150:F151,F146:F147,F142:F143,F138:F139,F134:F135,F130:F131,F126:F127,F122:F123,F118:F119,F114:F115,F110:F111,F106:F107,F102:F103,F98:F99,F94:F95,F90:F91,F86:F87,F82:F83,F78:F79,F58:F59,F54:F55,F50:F51,F46:F47,F42:F43,F38:F39").MergeArea.ClearContents
                ws.Range("B18:C161,I18:W161,F34:F35,F30:F31,F26:F27,F22:F23,F18:F19,F158:F159,F154:F155,F150:F151,F146:F147,F142:F143,F138:F139,F134:F135,F130:F131,F126:F127,F122:F123,F118:F119,F114:F115,F110:F111,F106:F107,F102:F103,F98:F99,F94:F95,F90:F91,F86:F87,F82:F83,F78:F79,F58:F59,F54:F55,F50:F51,F46:F47,F42:F43,F38:F39").Locked = False
                ws.Range("H11") = ws.Range("H11").Value + 1
                ws.Range("K165") = "Non signé"
                ws.Protect "mdp"
           End If
    Next ws

Mis à part le fait que cela me parait très lourd, cela ne fonctionne pas : Erreur 1004 La méthode Range de l'objet _WorkSheets a échoué.

J'ai testé en utilisant Union, que je ne connaissais pas, mais sans succès non plus

Auriez-vous une idée ?

Merci d'avance !

Nico.

Bonjour,

Un fichier nous aurait aidé.

Bonjour Raja,

Bien sûr, voici le fichier en PJ.

Cordialement,

Nico.

55cqi-fof.xlsm (76.83 Ko)

Re,

A mon avis ça vient du problème des cellules fusionnées.

Mais .MergeArea n'est pas censé prendre en compte les cellules fusionnées justement ?

Re,

J'ai également testé ce code sans plus de succès :

Private Sub CommandButton1_Click()

Mdp = Application.InputBox("Veuillez introduire votre mot de passe :")
If Mdp <> "mdp" Then MsgBox "Accès refusé !": Exit Sub

Dim cell As Range
Dim Plage1 As Range
Set Plage1 = Range("Delete")
    For Each ws In Worksheets
           If Not ws.Name Like "Statistiques" Then
                ws.Unprotect "mdp"
    For Each cell In Plage1
       If cell.MergeCells = True Then
         cell.MergeArea.ClearContents
        Else
         cell.ClearContents
      End If
    Next cell
                ws.Range("H11") = ws.Range("H11").Value + 1
                ws.Range("K165") = "Non signé"
                ws.Protect "mdp"
           End If
    Next ws

End Sub

Sniff sniff

Bonjour,

A essayer :

Private Sub CommandButton1_Click()
    Dim c As Range, ws As Worksheet
    Mdp = Application.InputBox("Veuillez introduire votre mot de passe :")
    If Mdp <> "mdp" Then MsgBox "Accès refusé !": Exit Sub
    For Each ws In Worksheets
        If Not ws.Name Like "Statistiques" Then
            ws.Unprotect "mdp"
            For Each c In ws.Range("B18:W161")
                If c.Interior.ColorIndex = xlColorIndexNone Then
                    c.MergeArea.ClearContents
                    c.MergeArea.Locked = False
                End If
            Next c
            ws.Range("H11") = ws.Range("H11").Value + 1
            ws.Range("K165") = "Non signé"
            ws.Protect "mdp"
        End If
    Next ws
End Sub

Cordialement.

Salut MFerrand,

Comme presque toujours, tu me sauve la vie !

Je vais devoir faire quelques modifications du fichier concernant les couleurs vu que j'utilise des MFC, mais c'est aisément jouable

Un tout grand merci !

Nico.

Rechercher des sujets similaires à "selectionner plages discontinues"