[Résolu] Copier coller en incrémentant les cellules

Sub MiseEnForme()

Application.ScreenUpdating = 0

'Mise en forme // copie semaine et dates
For s = 1 To 419 Step 8
'Copie la ligne contenant la semaine sous tour d'injection (source)
Range(Cells(4, s), Cells(4, s + 6)).Select
Selection.Copy

'Selection de la Cellule cible de la seamine suivante
Cells(4, s + 8).Select
ActiveSheet.Paste

'Ajoute +1 au numéro de semaine dans la cellule cible
Cells(4, s + 12).Value = Cells(4, s + 4).Value + 1

' Copie les dates de week end
Range(Cells(7, s), Cells(7, s + 6)).Select
Selection.Copy
Cells(7, s + 8).Select
ActiveSheet.Paste

' Copie les dates de la semaine
Range(Cells(23, s), Cells(23, s + 6)).Select
Selection.Copy
Cells(23, s + 8).Select
ActiveSheet.Paste
Next s

'Copie du code couleur
For i = 1 To 389
' Copie les couleurs des 6 premières semaines de week end et les colle
Range(Cells(20, i), Cells(20, i + 47)).Select
Selection.Copy
Cells(20, i + 48).Select
ActiveSheet.Paste

' Copie les couleurs des 6 premières semaines de la semaine et les collent
Range(Cells(37, i), Cells(37, i + 47)).Select
Selection.Copy
Cells(37, i + 48).Select
ActiveSheet.Paste

'Copie les couleurs des 6 premières semaines de RTT et les collent
Range(Cells(52, i), Cells(52, i + 47)).Select
Selection.Copy
Cells(52, i + 48).Select
ActiveSheet.Paste
Next i

'copie le gris separant deux semaines
For c = 8 To 416 Step 8
Range(Cells(1, c), Cells(62, c)).Select
Selection.Copy
Cells(1, c + 8).Select
ActiveSheet.Paste
Next c

End Sub

Cliquez pour agrandir...