XL 2019 Dans mon tableau comment effacer ligne par ligne sauf les entêtes

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

Nicolaroute

XLDnaute Nouveau
Bonjour à tous et toutes,
Aujourd'hui, voici mon problème: je n'arrive pas à trouver le code VBA pour empêcher mon bouton " Effacer" en cas d'erreur de saisie,
justement d'effacer l'entête de mon tableau D15: J15. Mon Tableau avec les entêtes comprises de "D15 à J33"
Voici mon code :
Dim DernLigne As Long

DernLigne = Range("D33:J33").End(xlUp).Row

'If activecells is in Range("D15" & DernLigne & ":J15" & DernLigne).Select Then Exit Sub ' la c'est pas bon!!!

If MsgBox("Confirmez-vous l'effacement de ce nouveau Tissu ?", vbYesNo, " Ligne Effacée") = vbYes Then

Range("D" & DernLigne & ":J" & DernLigne).Select
Selection.ClearContents
Selection.Borders.Value = 0
With Selection.Interior
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorDark1
.TintAndShade = 0
.PatternTintAndShade = 0
End With
MsgBox "La Ligne a été effacée !"
End If
Range("D" & DernLigne).Select


Je vous remercie de votre aide.
 
Solution
Bonjour Nicolas,

Je te laisse essayer ce code VBA (non testé) :
VB:
Sub Essai()
  If MsgBox("Confirmez-vous l'effacement de ce nouveau Tissu ?", 4, " Ligne Effacée") <> 6 Then Exit Sub
  Dim DernLigne&: DernLigne = Cells(Rows.Count, 4).End(3).Row
  If DernLigne = 1 Then Exit Sub 'évite d'effacer la ligne d'en-têtes ! (si elle est bien en ligne 1)
  Application.ScreenUpdating = 0
  With Cells(DernLigne, 4).Resize(, 7)
    .ClearContents: .Borders.LineStyle = -4142
    With Selection.Interior
      .PatternColorIndex = -4105: .ThemeColor = 1
      .TintAndShade = 0: .PatternTintAndShade = 0
    End With
  End With
  Cells(DernLigne, 4).Select: Application.ScreenUpdating = -1
  MsgBox "La Ligne a été effacée !"
End Sub
soan
Bonjour Nicolas,

Je te laisse essayer ce code VBA (non testé) :
VB:
Sub Essai()
  If MsgBox("Confirmez-vous l'effacement de ce nouveau Tissu ?", 4, " Ligne Effacée") <> 6 Then Exit Sub
  Dim DernLigne&: DernLigne = Cells(Rows.Count, 4).End(3).Row
  If DernLigne = 1 Then Exit Sub 'évite d'effacer la ligne d'en-têtes ! (si elle est bien en ligne 1)
  Application.ScreenUpdating = 0
  With Cells(DernLigne, 4).Resize(, 7)
    .ClearContents: .Borders.LineStyle = -4142
    With Selection.Interior
      .PatternColorIndex = -4105: .ThemeColor = 1
      .TintAndShade = 0: .PatternTintAndShade = 0
    End With
  End With
  Cells(DernLigne, 4).Select: Application.ScreenUpdating = -1
  MsgBox "La Ligne a été effacée !"
End Sub
soan
 
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

  • Question Question
Microsoft 365 worksheet_change
Réponses
29
Affichages
540
Réponses
9
Affichages
601
Retour