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
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