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 !

VB:
Private Sub Worksheet_Change(ByVal Target As Range)
If Not IsDate(Target(1)) Or Target.Count > 1 Then Exit Sub
Application.ScreenUpdating = False
Application.EnableEvents = False
While Month(Target + 1) = Month(Target)
    Set Target = Target(2)
    Target = Target(0) + 1
    Target.NumberFormat = Target(0).NumberFormat
Wend
Application.EnableEvents = True
End Sub
Salut Patrick 🙂
 
Avec une RAZ :
VB:
Private Sub Worksheet_Change(ByVal Target As Range)
If Not IsDate(Target(1)) Or Target.Count > 1 Then Exit Sub
Application.ScreenUpdating = False
Application.EnableEvents = False
While Month(Target + 1) = Month(Target)
    Set Target = Target(2)
    Target = Target(0) + 1
    Target.NumberFormat = Target(0).NumberFormat
Wend
Range(Target(2), Cells(Rows.Count, Target.Column)).ClearContents 'RAZ dessous
Application.EnableEvents = True
End Sub
 
Avec une RAZ :
VB:
Private Sub Worksheet_Change(ByVal Target As Range)
If Not IsDate(Target(1)) Or Target.Count > 1 Then Exit Sub
Application.ScreenUpdating = False
Application.EnableEvents = False
While Month(Target + 1) = Month(Target)
    Set Target = Target(2)
    Target = Target(0) + 1
    Target.NumberFormat = Target(0).NumberFormat
Wend
Range(Target(2), Cells(Rows.Count, Target.Column)).ClearContents 'RAZ dessous
Application.EnableEvents = True
End Sub
Merci
 
RE,

Ou utiliser les outils intégrés :
  1. Tapez un nombre ou une date dans une cellule.
  2. Sélectionnez la plage de cellules dans laquelle la série doit être créée.
  3. Basculez sur l'onglet Accueil du ruban.
  4. Cliquez sur l'icône Remplissage dans le groupe Edition et sélectionnez Série dans le menu.
1567448864910.png
 
Bonjour le fil, le forum,

En VBA je préfère nettement ceci, sans boucle :
VB:
Private Sub Worksheet_Change(ByVal Target As Range)
If Not IsDate(Target(1)) Or Target.Count > 1 Then Exit Sub
Application.EnableEvents = False
With Target.Resize(DateSerial(Year(Target), Month(Target) + 1, 1) - Target)
    .NumberFormat = Target.NumberFormat
    .DataSeries
    .Offset(.Count).Resize(Rows.Count - .Count - .Row + 1).Delete xlUp 'RAZ dessous
End With
Application.EnableEvents = True
End Sub
Bonne journée.
 
Bonjour le fil, le forum,

En VBA je préfère nettement ceci, sans boucle :
VB:
Private Sub Worksheet_Change(ByVal Target As Range)
If Not IsDate(Target(1)) Or Target.Count > 1 Then Exit Sub
Application.EnableEvents = False
With Target.Resize(DateSerial(Year(Target), Month(Target) + 1, 1) - Target)
    .NumberFormat = Target.NumberFormat
    .DataSeries
    .Offset(.Count).Resize(Rows.Count - .Count - .Row + 1).Delete xlUp 'RAZ dessous
End With
Application.EnableEvents = True
End Sub
Bonne journée.
bnj
et merci ca marche bien
juste un problème au dessus de la dernier date j'ai des case de calcule alors chaque foi la date change j'ai un problème des dernier ligne
je veux toujours travailler sur même tableau
 

Pièces jointes

Bonjour,

Essaie le code de job75 modifié :
VB:
Private Sub Worksheet_Change(ByVal Target As Range)
If Not IsDate(Target(1)) Or Target.Count > 1 Then Exit Sub
If Target.Address <> "$K$11" Then Exit Sub
If Day(Target) <> 1 Then Exit Sub
Application.EnableEvents = False
[K12:K41] = ""
Rows("12:41").Hidden = False
With Target.Resize(DateSerial(Year(Target), Month(Target) + 1, 1) - Target)
    .NumberFormat = Target.NumberFormat
    .DataSeries
End With
With Application
  If .CountA([K39:K41]) < 3 Then
    Rows(41).Offset(-2 + .CountA([K39:K41])).Resize(3 - .CountA([K39:K41])).Hidden = True
  End If
End With
Application.EnableEvents = True
End Sub

Dans le classeur joint, j'ai ajouté des mises en forme pour colorer en bleu les samedis et dimanche. Les modifs sont seulement sur la feuille tab. Je peux les reporter sur les autres.

Daniel
 

Pièces jointes

- 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

Réponses
5
Affichages
265
Réponses
7
Affichages
135
Réponses
18
Affichages
182
  • Question Question
Microsoft 365 format date
Réponses
3
Affichages
139
Réponses
4
Affichages
210
Retour