Microsoft 365 Effacer cellules pleines en conservant mise en forme sauf bordures

[Moreno076]

Bonjour le forum

Je bloque sur une macro.

Je voudrais que dans le fichier ci-joint le contenu des cellules des lignes pleines commencant à partir de A2 jusqu'à N se suppriment mais sans supprimer la mise en forme mais en supprimant par contre les bordures.

Sub EFF()
'
' EFF Macro
Dim Derlg&
Derlg = Worksheets("Synthèse").Range("a" & Rows.Count).End(xlUp).Row
If Derlg = 1 Then Exit Sub
Range("A2:N" & Derlg).Clear
Selection.Delete Shift:=xlUp
Application.DisplayAlerts = False
On Error Resume Next

Dim Feuille As Worksheet
'Pour toutes les feuilles dans CE classeur
For Each Feuille In ThisWorkbook.Worksheets
'si son nom est différent de "Feuil2" (à adapter bien sur) alors.....
If Feuille.Name <> "Synthèse" Then
'on empêche le message d'alerte à l'utilisateur
Application.DisplayAlerts = False
'on supprime la feuille
Feuille.Delete
'on remets le message d'alerte excel !!! très important !!!
Application.DisplayAlerts = True
'fin du test
End If
'feuille suivante
Next Feuille

Range("A2").Select

End Sub

Merci pour votre aide. J'ai mis la macro EFF en bouton

 

[Staple1600]

Bonjour le fil

Moreno076
Voir du côté de : ClearContents

 

[Moreno076]

Bonjour le fil

Moreno076
Voir du côté de : ClearContents

Impec merci je regarde pour les bordures maintenant

 

[Staple1600]

Re

On peut aussi faire comme ceci pour remplir les cellules de vide 😉

Sub Erazer_Cells()
Dim ws As Worksheet, lig&
Application.ScreenUpdating = False
For Each ws In Worksheets
lig = ws.Cells(Rows.Count, 1).End(3).Row
ws.Cells(2, "A").Resize(lig, 14) = ""
Next
End Sub

 

[Staple1600]

Re

Pour déborder les bordures 😉

Sub Erazer_Cells_et_Bords()
Dim ws As Worksheet, lig&
Application.ScreenUpdating = False
For Each ws In Worksheets
lig = ws.Cells(Rows.Count, 1).End(3).Row
With ws.Cells(2, "A").Resize(lig, 14)
  .Value = ""
  .Borders.LineStyle = xlNone
End With
Next
End Sub

 

[Moreno076]

Re

Pour déborder les bordures 😉

Sub Erazer_Cells_et_Bords()
Dim ws As Worksheet, lig&
Application.ScreenUpdating = False
For Each ws In Worksheets
lig = ws.Cells(Rows.Count, 1).End(3).Row
With ws.Cells(2, "A").Resize(lig, 14)
  .Value = ""
  .Borders.LineStyle = xlNone
End With
Next
End Sub

Merci Staple1600 C'est impeccable par contre j'ai un bug sur autre chose je cherche

 

[Staple1600]

Re

Qui dit autre bug, normalement fit nouvelle discussion 😉

 

[Moreno076]

C'est juste que je voudrais que ce soit juste dans feuille Synthèse, à ca efface dans chaque feuille

 

[Staple1600]

Re

Bah oui, ton code dans ton premier message bouclait sur toutes les feuilles, donc je suis parti en boucle 😉
Tu ne vois pas comment sortir de la boucle et faire l’adaptation nécessaire pour ne traiter que la feuille Synthèse ?

 

[Moreno076]

Sub Erazer_Cells_et_Bords()
Dim ws As Worksheet("Synthèse"), lig&
Application.ScreenUpdating = False
For Each ws In Worksheets
lig = ws.Cells(Rows.Count, 1).End(3).Row
With ws.Cells(2, "A").Resize(lig, 14)
.Value = ""
.Borders.LineStyle = xlNone
End With
Next
End Sub

?

 

[Staple1600]

Re

Non, il faut sortir de la boucle
(donc la supprimer)
Allez, c'est dimanche, kado 😉
Deux pour le prix d'une 😉

Sub RAZ_Synthese_A()
Dim lig&
Application.ScreenUpdating = False
lig = Sheets("Synthèse").Cells(Rows.Count, 1).End(3).Row
With Sheets("Synthèse").Cells(2, "A").Resize(lig, 14)
  .Value = ""
  .Borders.LineStyle = xlNone
End With
End Sub

Sub RAZ_Synthese_Light()
Dim f As Worksheet
Set f = Sheets("Synthèse")
Application.ScreenUpdating = False
With f.Cells(2, "A").Resize(f.Cells(Rows.Count, 1).End(3).Row, 14)
.Value = "": .Borders.LineStyle = -4142
End With
End Sub

 

[Moreno076]

Merci. Désolé du temps de réponse Je corrigeais mon bug en même temps. J'ai trouvé.

Merci bien tout fonctionne pour ce sujet. 🙂