Suite de date automatique

bonjour
je cherche à mettre la suite de date automatique depuis le 1 janvier jusqu'au 31 décembre 2013 en format date 01/01/2013.si a2<>"";si a3<> et la date serai en colonne D à partir row>1
je suis attentif a ce que vous pouvez me présenter si c'est en VBA bien sur c'est beaucoup mieux je vous laisse un peu de code vous inspirer

Code:

---

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217

Private Sub Bouton_Français2_Click()   'Masquage du formulaire Choix_Langue.Hide   'Réinitialisation Cells.Value = Empty Cells.Borders.LineStyle = xlNone Cells.Font.ColorIndex = xlAutomatic Cells.Font.Bold = False Cells.VerticalAlignment = xlCenter Cells.MergeCells = False ActiveWindow.DisplayGridlines = True   Cells.Interior.ColorIndex = xlColorIndexNone 'rajout     'Liste personnelle Application.AddCustomList ListArray:=Array("Lundi", "Mardi", "Mercredi", "Jeudi", "Vendredi", "Samedi", "Dimanche")   'Mise en forme 'Range("A1:AJ1").HorizontalAlignment = xlCenterAcrossSelection Range("A1").HorizontalAlignment = xlCenterAcrossSelection Cells.Font.Size = 11   'Année Dim Message, Titre, Année, Défaut Message = "Entrez l'année" Titre = "Année du calendrier" Défaut = Year(Now) Année = InputBox(Message, Titre, Défaut)   'En-tête ActiveSheet.Name = Année   'Mois Range("A1").Value = "Janvier" Range("A33").Value = "Février" Range("A65").Value = "Mars" Range("A97").Value = "Avril" Range("A129").Value = "Mai" Range("A161").Value = "Juin" Range("A193").Value = "Juillet" Range("A225").Value = "Août" Range("A257").Value = "Septembre" Range("A289").Value = "Octobre" Range("A321").Value = "Novembre" Range("A353").Value = "Décembre"   'Dates 'Mois en 31 jours For a = 1 To 31 Range("B" & a + 1).Value = a     'mars Range("B" & a + 65).Value = a   'mai Range("B" & a + 129).Value = a   'juillet Range("B" & a + 193).Value = a 'aout Range("B" & a + 225).Value = a 'octobre Range("B" & a + 289).Value = a 'decembre Range("B" & a + 353).Value = a Next a   'Mois en 30 jours For a = 1 To 30 'avril Range("B" & a + 97).Value = a 'juin Range("B" & a + 161).Value = a 'septembre Range("B" & a + 257).Value = a 'novembre Range("B" & a + 321).Value = a Next a   'Février For a = 1 To 28 Range("B" & a + 33).Value = a Next a On Error Resume Next Weekday ("29/02/" & Année) If Err.Number = 13 Then Err.Clear: Range("B62").Value = Empty Else Range("B62").Value = 29   'Jours 'Janvier Jour = Weekday("01/01/" & Année) If Jour = 2 Then Journée = "Lundi" If Jour = 3 Then Journée = "Mardi" If Jour = 4 Then Journée = "Mercredi" If Jour = 5 Then Journée = "Jeudi" If Jour = 6 Then Journée = "Vendredi" If Jour = 7 Then Journée = "Samedi" If Jour = 1 Then Journée = "Dimanche" Range("A2").Value = Journée Range("A2").AutoFill Destination:=Range("A2:A32") 'Février   Range("A34").Value = Range("A26").Value If Range("A62").Value = Empty Then Range("A34").AutoFill Destination:=Range("A34:A61") Else Range("A34").AutoFill Destination:=Range("A34:A62")   'Mars If Range("B62").Value = Empty Then Range("A66").Value = Range("A55").Value Else Range("A66").Value = Range("A55").Value Range("A66").AutoFill Destination:=Range("A66:A96")   'Avril Range("A98").Value = Range("A58").Value Range("A98").AutoFill Destination:=Range("A98:A127")   'Mai Range("A130").Value = Range("A121").Value Range("A130").AutoFill Destination:=Range("A130:A160")   'Juin Range("A162").Value = Range("A154").Value Range("A162").AutoFill Destination:=Range("A162:A191")   'Juillet Range("A194").Value = Range("A185").Value Range("A194").AutoFill Destination:=Range("A194:A224")   'Août Range("A226").Value = Range("A218").Value Range("A226").AutoFill Destination:=Range("A226:A256")   'Septembre Range("A258").Value = Range("A250").Value Range("A258").AutoFill Destination:=Range("A258:A287")   'Octobre Range("A290").Value = Range("A281").Value Range("A290").AutoFill Destination:=Range("A290:A320")   'Novembre Range("A322").Value = Range("A314").Value Range("A322").AutoFill Destination:=Range("A322:A351")   'Décembre Range("A354").Value = Range("A345").Value Range("A354").AutoFill Destination:=Range("A354:A384")   'Semaines b = 1 For Mois = 1 To 36 Step 3 For a = 2 To 384 If Cells(a, Mois).Value = "Lundi" Then Cells(a, Mois + 2).Value = b: b = b + 1 Next a Next Mois   'Mise en page 'Grille ActiveWindow.DisplayGridlines = False With Range("A1:B384").Borders .LineStyle = xlContinuous .ColorIndex = 1 ''''''''''''''''''''''''''''''''''''''''' couleur total grille End With ActiveWindow.DisplayGridlines = False With Range("D1:AZ384").Borders .LineStyle = xlContinuous .ColorIndex = 1 ''''''''''''''''''''''''''''''''''''''''' couleur total grille End With       Range("A1:AZ384").Borders(xlEdgeLeft).Weight = xlThick ''''' barre Range("A1:AZ384").Borders(xlEdgeTop).Weight = xlThick ''' barre Range("A1:AZ384").Borders(xlEdgeBottom).Weight = xlThick ''' barre Range("A1:AZ384").Borders(xlEdgeRight).Weight = xlThick '''' barre Range("A1:AZ384").Borders(xlEdgeLeft).ColorIndex = 5 ''''''''barre de gauche Range("A1:AZ384").Borders(xlEdgeTop).ColorIndex = 5 '''''''''barre du haut Range("A1:AZ384").Borders(xlEdgeBottom).ColorIndex = 5 ''''''barre du bas Range("A1:AZ384").Borders(xlEdgeRight).ColorIndex = 5 ''''''barre de droite Range("A1:AZ384").Font.Bold = True     'Semaines b = 1 For Mois = 1 To 36 Step 3 For a = 2 To 384 ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' If Cells(a, Mois).Value = "Lundi" Then Cells(a, Mois + 2).Value = b: b = b + 1 If Cells(a, Mois).Value = "Lundi" Then If a = 2 Then GoTo FinDeBoucle Else Range(Cells(a, Mois), Cells(a, Mois + 51)).Borders(xlEdgeTop).Weight = xlMedium: Range(Cells(a, Mois), Cells(a, Mois + 51)).Borders(xlEdgeTop).ColorIndex = 5 '''couleur bas cellulle dimanche   If Cells(a, Mois).Value = "Dimanche" Then Cells(a, Mois).Font.ColorIndex = 5 '''couleur du dimanche If Cells(a, Mois).Value = "Dimanche" Then Cells(a, Mois + 1).Font.ColorIndex = 5 '''chiffre du dimanche   If Cells(a, Mois).Value = "Lundi" Then If a = 4 Then Range(Cells(a - 2, Mois + 2), Cells(a - 1, Mois + 2)).Cells.MergeCells = True If Cells(a, Mois).Value = "Lundi" Then If a = 5 Then Range(Cells(a - 3, Mois + 2), Cells(a - 1, Mois + 2)).Cells.MergeCells = True If Cells(a, Mois).Value = "Lundi" Then If a = 6 Then Range(Cells(a - 4, Mois + 2), Cells(a - 1, Mois + 2)).Cells.MergeCells = True If Cells(a, Mois).Value = "Lundi" Then If a = 7 Then Range(Cells(a - 5, Mois + 2), Cells(a - 1, Mois + 2)).Cells.MergeCells = True If Cells(a, Mois).Value = "Lundi" Then If a = 8 Then Range(Cells(a - 6, Mois + 2), Cells(a - 1, Mois + 2)).Cells.MergeCells = True If Cells(a, Mois).Value = "Lundi" Then If a = 9 Then Range(Cells(a - 7, Mois + 2), Cells(a - 1, Mois + 2)).Cells.MergeCells = True   If Cells(a, Mois + 2).Value = Empty Then GoTo FinDeBoucle   If Cells(a, Mois + 2).Row <= 26 Then Range(Cells(a, Mois + 2), Cells(a + 6, Mois + 2)).Cells.MergeCells = True If Cells(a, Mois + 2).Row = 27 Then Range(Cells(a, Mois + 2), Cells(a + 5, Mois + 2)).Cells.MergeCells = True If Cells(a, Mois + 2).Row = 28 Then Range(Cells(a, Mois + 2), Cells(a + 4, Mois + 2)).Cells.MergeCells = True If Cells(a, Mois + 2).Row = 29 Then Range(Cells(a, Mois + 2), Cells(a + 3, Mois + 2)).Cells.MergeCells = True If Cells(a, Mois + 2).Row = 30 Then Range(Cells(a, Mois + 2), Cells(a + 2, Mois + 2)).Cells.MergeCells = True If Cells(a, Mois + 2).Row = 31 Then Range(Cells(a, Mois + 2), Cells(a + 1, Mois + 2)).Cells.MergeCells = True FinDeBoucle: Next a Next Mois   Range("C:C,C:C,I:I,L:L,O:O,R:R,U:U,X:X,AA:AA,AD:AD,AG:AG,AJ:AJ").Font.Bold = True   'Fermeture du formulaire Unload Choix_Langue   End Sub

---

cordialement

Bonjour Patrick,

Qu'est-ce qui ne va pas avec ta macro ? A part la colonne C - je ne sais pas ce que tu veux y mettre - le résultat a l'air correct.

oui le résultat est très correcte mais j'ai besoin incrémenter la date en format

01/01/2013 à partir de la ligne de 2 de la colonne C

es-ce possible merci

Là, je ne comprends pas trop; est-ce que tu peux donner ce que tu souhaites pour quelques lignes ?

bonjour il faut bien imaginer que la feuille ce crée tout seule pour le coup
et avec simplement l'année dans un imputbox
il faut aussi imaginer que je passe d'une année à l'autre sur plusieurs année donc même problème
pour mettre les dates automatiquement car j'en ai besoin
donc comment on pourrai faire svp dans la colonne D row>1 pour que la date d’après ce que vous voyez ce mets automatiquement es possible
cordialement
si a2<>"" résultat en D2 01/01/2013 "2013 c'est aussi la date de l'onglet "
si a3<>"" résultat en D3 02/01/2013 et ainsi de suite
cordialement et merci encore d'essayer de comprendre

J'ai ajouté la macro "Dates" avant la mise en forme.

Code:

---

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223

Private Sub Bouton_Français2_Click()   'Masquage du formulaire 'Choix_Langue.Hide   'Réinitialisation Cells.Value = Empty Cells.Borders.LineStyle = xlNone Cells.Font.ColorIndex = xlAutomatic Cells.Font.Bold = False Cells.VerticalAlignment = xlCenter Cells.MergeCells = False ActiveWindow.DisplayGridlines = True   Cells.Interior.ColorIndex = xlColorIndexNone 'rajout     'Liste personnelle Application.AddCustomList ListArray:=Array("Lundi", "Mardi", "Mercredi", "Jeudi", "Vendredi", "Samedi", "Dimanche")   'Mise en forme 'Range("A1:AJ1").HorizontalAlignment = xlCenterAcrossSelection Range("A1").HorizontalAlignment = xlCenterAcrossSelection Cells.Font.Size = 11   'Année Dim Message, Titre, Année, Défaut Message = "Entrez l'année" Titre = "Année du calendrier" Défaut = Year(Now) Année = InputBox(Message, Titre, Défaut)   'En-tête ActiveSheet.Name = Année   'Mois Range("A1").Value = "Janvier" Range("A33").Value = "Février" Range("A65").Value = "Mars" Range("A97").Value = "Avril" Range("A129").Value = "Mai" Range("A161").Value = "Juin" Range("A193").Value = "Juillet" Range("A225").Value = "Août" Range("A257").Value = "Septembre" Range("A289").Value = "Octobre" Range("A321").Value = "Novembre" Range("A353").Value = "Décembre"   'Dates 'Mois en 31 jours For a = 1 To 31 Range("B" & a + 1).Value = a     'mars Range("B" & a + 65).Value = a   'mai Range("B" & a + 129).Value = a   'juillet Range("B" & a + 193).Value = a 'aout Range("B" & a + 225).Value = a 'octobre Range("B" & a + 289).Value = a 'decembre Range("B" & a + 353).Value = a Next a   'Mois en 30 jours For a = 1 To 30 'avril Range("B" & a + 97).Value = a 'juin Range("B" & a + 161).Value = a 'septembre Range("B" & a + 257).Value = a 'novembre Range("B" & a + 321).Value = a Next a   'Février For a = 1 To 28 Range("B" & a + 33).Value = a Next a On Error Resume Next Weekday ("29/02/" & Année) If Err.Number = 13 Then Err.Clear: Range("B62").Value = Empty Else Range("B62").Value = 29   'Jours 'Janvier Jour = Weekday("01/01/" & Année) If Jour = 2 Then Journée = "Lundi" If Jour = 3 Then Journée = "Mardi" If Jour = 4 Then Journée = "Mercredi" If Jour = 5 Then Journée = "Jeudi" If Jour = 6 Then Journée = "Vendredi" If Jour = 7 Then Journée = "Samedi" If Jour = 1 Then Journée = "Dimanche" Range("A2").Value = Journée Range("A2").AutoFill Destination:=Range("A2:A32") 'Février   Range("A34").Value = Range("A26").Value If Range("A62").Value = Empty Then Range("A34").AutoFill Destination:=Range("A34:A61") Else Range("A34").AutoFill Destination:=Range("A34:A62")   'Mars If Range("B62").Value = Empty Then Range("A66").Value = Range("A55").Value Else Range("A66").Value = Range("A55").Value Range("A66").AutoFill Destination:=Range("A66:A96")   'Avril Range("A98").Value = Range("A58").Value Range("A98").AutoFill Destination:=Range("A98:A127")   'Mai Range("A130").Value = Range("A121").Value Range("A130").AutoFill Destination:=Range("A130:A160")   'Juin Range("A162").Value = Range("A154").Value Range("A162").AutoFill Destination:=Range("A162:A191")   'Juillet Range("A194").Value = Range("A185").Value Range("A194").AutoFill Destination:=Range("A194:A224")   'Août Range("A226").Value = Range("A218").Value Range("A226").AutoFill Destination:=Range("A226:A256")   'Septembre Range("A258").Value = Range("A250").Value Range("A258").AutoFill Destination:=Range("A258:A287")   'Octobre Range("A290").Value = Range("A281").Value Range("A290").AutoFill Destination:=Range("A290:A320")   'Novembre Range("A322").Value = Range("A314").Value Range("A322").AutoFill Destination:=Range("A322:A351")   'Décembre Range("A354").Value = Range("A345").Value Range("A354").AutoFill Destination:=Range("A354:A384")   'Semaines b = 1 For Mois = 1 To 36 Step 3 For a = 2 To 384 If Cells(a, Mois).Value = "Lundi" Then Cells(a, Mois + 2).Value = b: b = b + 1 Next a Next Mois Dates CInt(Année) 'Mise en page 'Grille ActiveWindow.DisplayGridlines = False With Range("A1:B384").Borders .LineStyle = xlContinuous .ColorIndex = 1 ''''''''''''''''''''''''''''''''''''''''' couleur total grille End With ActiveWindow.DisplayGridlines = False With Range("D1:AZ384").Borders .LineStyle = xlContinuous .ColorIndex = 1 ''''''''''''''''''''''''''''''''''''''''' couleur total grille End With       Range("A1:AZ384").Borders(xlEdgeLeft).Weight = xlThick ''''' barre Range("A1:AZ384").Borders(xlEdgeTop).Weight = xlThick ''' barre Range("A1:AZ384").Borders(xlEdgeBottom).Weight = xlThick ''' barre Range("A1:AZ384").Borders(xlEdgeRight).Weight = xlThick '''' barre Range("A1:AZ384").Borders(xlEdgeLeft).ColorIndex = 5 ''''''''barre de gauche Range("A1:AZ384").Borders(xlEdgeTop).ColorIndex = 5 '''''''''barre du haut Range("A1:AZ384").Borders(xlEdgeBottom).ColorIndex = 5 ''''''barre du bas Range("A1:AZ384").Borders(xlEdgeRight).ColorIndex = 5 ''''''barre de droite Range("A1:AZ384").Font.Bold = True     'Semaines b = 1 For Mois = 1 To 36 Step 3 For a = 2 To 384 ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' If Cells(a, Mois).Value = "Lundi" Then Cells(a, Mois + 2).Value = b: b = b + 1 If Cells(a, Mois).Value = "Lundi" Then If a = 2 Then GoTo FinDeBoucle Else Range(Cells(a, Mois), Cells(a, Mois + 51)).Borders(xlEdgeTop).Weight = xlMedium: Range(Cells(a, Mois), Cells(a, Mois + 51)).Borders(xlEdgeTop).ColorIndex = 5 '''couleur bas cellulle dimanche   If Cells(a, Mois).Value = "Dimanche" Then Cells(a, Mois).Font.ColorIndex = 5 '''couleur du dimanche If Cells(a, Mois).Value = "Dimanche" Then Cells(a, Mois + 1).Font.ColorIndex = 5 '''chiffre du dimanche   If Cells(a, Mois).Value = "Lundi" Then If a = 4 Then Range(Cells(a - 2, Mois + 2), Cells(a - 1, Mois + 2)).Cells.MergeCells = True If Cells(a, Mois).Value = "Lundi" Then If a = 5 Then Range(Cells(a - 3, Mois + 2), Cells(a - 1, Mois + 2)).Cells.MergeCells = True If Cells(a, Mois).Value = "Lundi" Then If a = 6 Then Range(Cells(a - 4, Mois + 2), Cells(a - 1, Mois + 2)).Cells.MergeCells = True If Cells(a, Mois).Value = "Lundi" Then If a = 7 Then Range(Cells(a - 5, Mois + 2), Cells(a - 1, Mois + 2)).Cells.MergeCells = True If Cells(a, Mois).Value = "Lundi" Then If a = 8 Then Range(Cells(a - 6, Mois + 2), Cells(a - 1, Mois + 2)).Cells.MergeCells = True If Cells(a, Mois).Value = "Lundi" Then If a = 9 Then Range(Cells(a - 7, Mois + 2), Cells(a - 1, Mois + 2)).Cells.MergeCells = True   If Cells(a, Mois + 2).Value = Empty Then GoTo FinDeBoucle   If Cells(a, Mois + 2).Row <= 26 Then Range(Cells(a, Mois + 2), Cells(a + 6, Mois + 2)).Cells.MergeCells = True If Cells(a, Mois + 2).Row = 27 Then Range(Cells(a, Mois + 2), Cells(a + 5, Mois + 2)).Cells.MergeCells = True If Cells(a, Mois + 2).Row = 28 Then Range(Cells(a, Mois + 2), Cells(a + 4, Mois + 2)).Cells.MergeCells = True If Cells(a, Mois + 2).Row = 29 Then Range(Cells(a, Mois + 2), Cells(a + 3, Mois + 2)).Cells.MergeCells = True If Cells(a, Mois + 2).Row = 30 Then Range(Cells(a, Mois + 2), Cells(a + 2, Mois + 2)).Cells.MergeCells = True If Cells(a, Mois + 2).Row = 31 Then Range(Cells(a, Mois + 2), Cells(a + 1, Mois + 2)).Cells.MergeCells = True FinDeBoucle: Next a Next Mois   Range("C:C,C:C,I:I,L:L,O:O,R:R,U:U,X:X,AA:AA,AD:AD,AG:AG,AJ:AJ").Font.Bold = True   'Fermeture du formulaire Unload Choix_Langue   End Sub Sub Dates(Année) Dim Ligne As Integer Ligne = Cells(Rows.Count, 1).End(xlUp).Row [D2] = DateSerial(Année, 1, 1) [D2].AutoFill Range("D2:D" & Ligne) End Sub

---