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

[Cra49]

Bonjour à tous,

Besoin de votre aide de nouveau, je vous met en PJ le fichier quasi original ^^
Il s'agit d'un fichier me servant à réaliser et à planifier le tour de service de mes équipes. Ce fichier fonctionne par semaine. Dans les colonnes où sont marquées "Albert et patrice", apparait sur mon vrai fichier le nom de mes gars, tout le reste est fixe.

J'aimerai copier coller la trame de mes semaines, en changeant à chaque fois le numéro de semaine, et les dates de week end et de semaine. J'ai également un roulement concernant mes couleurs, qui doivent changer toutes les semaines (une couleur fait poste C la semaine 1, B la semaine 2 A la semaine 3 RTT la semaine 4 Week end C la semaine 5 et week end A la semaine 6 (puis C la semaine 7...) et ainsi de suite -- oula je ne me sens pas très claire :s

Clairement sur mon fichier en PJ j'ai préparé les 6 premières semaines, et j'aimerai pouvoir copier coller ces 6 semaines, jusqu'à la semaine 52 (ou 53 en 2015), et ainsi pouvoir me réaliser une trame utilisable d'un an sur l'autre.

J'ai déjà un code, utilisant des copier coller à répétition, mais dès que je le lance, le fichier bloque ... je ne sais pas si c'est lié à mon réseau (fichier testé sur plusieurs PC) ou si cela vient de mon fichier,

Par avance merci,

Cra

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

 

[Dugenou]

Re : Copier coller en incrémentant les cellules

Bonjour
en remettant application.screenUpdating à 1 à la fin ça devrait aller mieux
et idéalement avec un fichier exemple ce serait parfait !

 

[Cra49]

Re : Copier coller en incrémentant les cellules

Ah voui effectivement ^^ Voila le fichier, il ne voulait pas s'envoyer de l'autre PC :/

 

[Cra49]

Re : Copier coller en incrémentant les cellules

Bonjour à tous,
J'ai finalement trouvé une solution qui fonctionne plutôt pas mal, pas forcément du grand code, mais bon ça me suffit pas mal =) Merci Dugenou, en remettant application.screenUpdating = 1 à la fin de mon code, ça marche bcp mieux =)

Bonne journée,

Cra