copier cellule avec la couleur

wrndid

XLDnaute Occasionnel
bonjour avec la fonction ex tract semaine
je sélectionne et copie le texte des cellules mai je n arrive pas a copier les couleur
avez vous une solution merci

Dim DateCherche
Dim J As Date
Dim Lg As Long
Dim e
Dim Kan As Date


DateCherche = InputBox("Veuillez saisir le numéro de semaine")
If DateCherche = 0 Or DateCherche = "" Then Exit Sub
If DateCherche < 1 Or DateCherche > 53 Then
MsgBox "Merci de saisir un numéro de semaine valide"
Exit Sub
End If

Lg = 3

Kan = DateCherche * 7 + CDate([noan] & ",1,3") - Weekday(CDate([noan] & ",1,3")) - 5
With Sheets("semaine")
.Cells(2, 3) = Cells(2, 4)
.Select
.Cells(1, 4) = "Semaines = " & DateCherche
With .Range("C3:AG9")
.ClearContents
.Interior.ColorIndex = xlNone
End With
For J = Kan To Kan + 6
Sheets(Format(J, "MMMM")).Cells(2 + Day(J), "C").Resize(1, 31).Copy
.Range("C" & Lg).PasteSpecial xlPasteValues
Lg = Lg + 1
Next J

Application.CutCopyMode = False
.Range("C1").Select
End With
 

Pièces jointes

  • MATRICE CALENDRIER.xls
    564.5 KB · Affichages: 102
  • MATRICE CALENDRIER.xls
    564.5 KB · Affichages: 101
  • MATRICE CALENDRIER.xls
    564.5 KB · Affichages: 99

Discussions similaires

Réponses
14
Affichages
692
Réponses
0
Affichages
172
Réponses
3
Affichages
598

Statistiques des forums

Discussions
312 393
Messages
2 088 006
Membres
103 695
dernier inscrit
acimi