Aide sur code VBA, effacement cellules plusieurs feuilles

[hypo78]

Bonjour à tous,

Je souhaite supprimer le contenu sur une même plage de cellules sur plusieurs feuilles de mon classeur.
Il faut que je crée une exception pour 3 feuilles (1 seule dans mon code mais je n'ai pas réussi à créer un groupe avec Array....).
J'ai commencé à élaborer un code mais si je suis là c'est que çà bloque.

Sub Macro1()
'
Dim w As Worksheet

For Each w In Worksheets
If w.Name <> "stat" Then
Range("D16:AE30").ClearContents
End If
Next
End Sub

Merci d'avance pour votre aide

 

[tototiti2008]

Re : Aide sur code VBA, effacement cellules plusieurs feuilles

Bonjour hypo,

à tester

Sub Macro1()
'
Dim w As Worksheet, Liste
Liste = Array("stat", "toto", "feuil1")

For Each w In Worksheets
If IsError(Application.Match(w.Name, Liste, 0)) Then
w.Range("D16:AE30").ClearContents
End If
Next
End Sub

 

[hypo78]

Re : Aide sur code VBA, effacement cellules plusieurs feuilles

Bonjour,

merci pour cette réponse rapide, mais à l’exécution de la macro j'ai le message d'erreur 1004, impossible de modifier une cellule fusionnée, alors qu'avec une manip manuelle çà ne pose pas de pb.....

Si c'est indispensable, je poste le fichier, mais je dois supprimer qques données.

Merci.

 

[JNP]

Re : Aide sur code VBA, effacement cellules plusieurs feuilles

Bonsoir le fil 🙂,
Défusionne alors 😛...

w.Range("D16:AE30").UnMerge

Bonne soirée 😎

 

[hypo78]

Re : Aide sur code VBA, effacement cellules plusieurs feuilles

Bonjour JP,

oui mais cette plage est composée de 56 plages fusionnées.... alors pour refusionner...
j'avais fait un code sans les exceptions, et la fusion ne posait pas de problème, étrange....

Sub Effacer_données()

For i = 1 To Worksheets.Count
With Worksheets(i)
Worksheets(i).Select
Range("D16:AE30").Select
Selection.ClearContents
End With
Next i

End Sub

encore merci.

 

[hypo78]

Re : Aide sur code VBA, effacement cellules plusieurs feuilles

re,

en faisant un mix des 2, çà ne boucle pas sur toutes les feuilles.... je désespère.

Sub Macro1()
'
Dim w As Worksheet, Liste
Liste = Array("stat", "database", "menu")

For Each w In Worksheets
If IsError(Application.Match(w.Name, Liste, 0)) Then
Range("D16:AE30").Select
Selection.ClearContents
End If
Next
End Sub

 

[tototiti2008]

Re : Aide sur code VBA, effacement cellules plusieurs feuilles

Re, JNP 😉,

peut-être comme ça

Sub Macro1()
'
Dim w As Worksheet, Liste
Liste = Array("stat", "toto", "feuil1")

For Each w In Worksheets
If IsError(Application.Match(w.Name, Liste, 0)) Then
w.Activate
w.Range("D16:AE30").Select
Selection.ClearContents
End If
Next
End Sub

 

[job75]

Re : Aide sur code VBA, effacement cellules plusieurs feuilles

Bonjour hypo78, tototiti, Jean-Noël,

Pour que la macro de tototiti beugue, il faut qu'il y ait des cellules fusionnées "à cheval" sur les limites des plages D16:AE30.

Pas très normal ça...

Alors essayez ces 2 solutions :

Sub Macro1()
Dim w As Worksheet, Liste, cel As Range
Liste = Array("stat", "toto", "feuil1")
For Each w In Worksheets
  If IsError(Application.Match(w.Name, Liste, 0)) Then
    For Each cel In w.Range("D16:AE30")
      cel = ""
    Next
  End If
Next
End Sub

ou pour effacer les cellules fusionnées "à cheval" :

Sub Macro1()
Dim w As Worksheet, Liste, cel As Range
Liste = Array("stat", "toto", "feuil1")
For Each w In Worksheets
  If IsError(Application.Match(w.Name, Liste, 0)) Then
    For Each cel In w.Range("D16:AE30")
      cel.MergeArea = ""
    Next
  End If
Next
End Sub

A+

 

[hypo78]

Re : Aide sur code VBA, effacement cellules plusieurs feuilles

Re,

la première solution fonctionne, et j'ai effectivement trouvé une cellule à cheval..😱

Merci et bonne soirée.