Appliquer une macro à toutes les feuilles

[thib1987]

Bonjour,

J'ai le code suivant qui a pour but de combler les dates manquantes par les mêmes informations que le jour d'avant. J'aimerai appliquer cette macro à toutes les feuilles en même temps. Est-ce possible ? Pour le moment elle s'applique à la feuille BGBM.

Sub insertMissingDate()
Dim wks As Worksheet
Dim lastRow As Long
Dim i As Integer
Dim cel As Range

Set wks = Worksheets("BGBM")
lastRow = wks.Range("C2").End(xlDown).Row

'screening de haut en bas
For i = lastRow To 3 Step -1
curcell = wks.Cells(i, 3).Value
prevcell = wks.Cells(i - 1, 3).Value

'boucle si plusieurs cellules vides
Do Until curcell - 1 = prevcell Or curcell = prevcell
'Insert new row
wks.Rows(i).Insert xlShiftDown

'Insertion de la nouvelle date
curcell = wks.Cells(i + 1, 3) - 1
wks.Cells(i, 3).Value = curcell
Loop
Next i

With wks
Application.ScreenUpdating = False
'boucle sur toutes les cellules des colonnes A et D
For Each cel In Range("A1" & Range("B" & wks.Rows.Count).End(xlUp).Row)
'si la cellule est vide, elle prend la valeur de la cellule du dessus
If cel.Value = "" Then cel.Value = cel.Offset(-1, 0).Value
Next cel 'prochaine cellule des colonnes A et D
End With

End Sub


Merci pour votre retour.

Thibault

 

[JM27]

bonjour
Peut être comme cela ( n'ayant pas de fichier pour tester)

Sub insertMissingDate()
Dim wks As Worksheet
Dim lastRow As Long
Dim i As Integer
Dim cel As Range
Dim I as byte
For I=1 to Worksheets.count
Set wks = Worksheets(I)
lastRow = wks.Range("C2").End(xlDown).Row

'screening de haut en bas
For i = lastRow To 3 Step -1
curcell = wks.Cells(i, 3).Value
prevcell = wks.Cells(i - 1, 3).Value

'boucle si plusieurs cellules vides
Do Until curcell - 1 = prevcell Or curcell = prevcell
'Insert new row
wks.Rows(i).Insert xlShiftDown

'Insertion de la nouvelle date
curcell = wks.Cells(i + 1, 3) - 1
wks.Cells(i, 3).Value = curcell
Loop
Next i

With wks
Application.ScreenUpdating = False
'boucle sur toutes les cellules des colonnes A et D
For Each cel In Range("A1:D" & Range("B" & wks.Rows.Count).End(xlUp).Row)
'si la cellule est vide, elle prend la valeur de la cellule du dessus
If cel.Value = "" Then cel.Value = cel.Offset(-1, 0).Value
Next cel 'prochaine cellule des colonnes A et D
End With
next
End Sub

 

[thib1987]

Bonjour JM,

Voici le fichier avec le code proposé. Il semblerait que la deuxième partie du code ne s'applique qu'à la feuille active. Est-ce qu'une modification permettrait de remplir toutes les nouvelles lignes automatiquement ?

Merci,

Thibault

 

[JM27]

Bonjour
a priori il manque un point devant le range
correction

For Each cel In .Range("A1:D" & .Range("B" & wks.Rows.Count).End(xlUp).Row)

 

[thib1987]

En effet, merci beaucoup !

 

[thib1987]

Je voulais appliquer la macro à partir de la deuxième sheet B= 2 to workshets.count pour pouvoir avoir une page de garde et un bouton pour la macro. A ce moment la deuxième partie de la macro ne fonctionne plus.

Quelque chose à changer dans cette partie là pour que la macro ne s'applique qu'à partir de la deuxième sheet ?

Merci,

Thibault

 

[JM27]

Bonsoir