Sub Extract_Sem()
Dim DateCherche, i&, J&, K&, L&
Dim TabReport(1 To 7, 1 To 31)
K = 0
Sheets("semaine").Cells(2, 3).Value = Application.ActiveSheet.Cells(2, 4).Value
DateCherche = InputBox("Veuillez saisir le numéro de semaine")
If DateCherche = 0 Or DateCherche = "" Then Exit Sub
If DateCherche < 1 Or DateCherche > 55 Then
MsgBox "Merci de saisir un numéro de semaine valide"
Exit Sub
End If
With ActiveSheet
For i = 2 To 33
If Format(DateSerial(Range("noan"), .Cells(2, 1), .Cells(i, 3)), "WW", vbMonday, vbFirstFourDays) = DateCherche Then
K = K + 1
For J = 1 To 31
TabReport(K, J) = .Cells(i, J + 2)
Next J
End If
Next i
razsem
efcouleur
End With
If K = 0 Then
MsgBox "Cette semaine n'est pas présente sur cette feuille"
Else
Sheets("semaine").Cells(3, 3).Resize(7, 31) = TabReport
Sheets("semaine").Cells(1, 4).Value = "Semaines = " & DateCherche
MsgBox "Semaine copiée"
End If
mois = Month(Range("c2"))
i = mois
Z = 3
Annee = Range("noan")
J = FNbrDeJrDuMois(mois - 1, Annee) + 2
For a = 4 To 33
If Cells(5, 3).Value = "" Then
Cells(5, a).Value = Sheets(FNomDuMois$(mois - 1)).Cells(J, a).Value
End If
If a = 33 Then
J = J - 1
End If
Next a
For a = 4 To 33
If Cells(4, 3).Value = "" Then
Cells(4, 4).Value = Sheets(FNomDuMois$(mois - 1)).Cells(J, a).Value
End If
If a = 33 Then
J = J - 1
End If
Next a
For a = 4 To 33
If Cells(3, 3).Value = "" Then
Cells(3, a).Value = Sheets(FNomDuMois$(mois - 1)).Cells(J, a).Value
End If
If a = 33 Then
J = J - 1
End If
Next a
If Cells(6, 3).Value = "" Then
Cells(6, a).Value = Sheets(FNomDuMois$(i + 1)).Cells(Z, a).Value
End If
''''''''''''''''''''''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''''''''
'ici le code modifié
For a = 4 To 33
Cells(7, a).Value = IIf(a <> 33, Sheets(FNomDuMois$(i + 1)).Cells(Z, a).Value, Sheets(FNomDuMois$(i + 1)).Cells(Z + 1, a).Value)
Next a
For a = 4 To 33
If Cells(8, 3).Value = "" Then
Cells(8, a).Value = Sheets(FNomDuMois$(i + 1)).Cells(Z, a).Value
End If
If a = 33 Then
Z = Z + 1
End If
Next a
For a = 4 To 33
If Cells(8, 3).Value = "" Then
Cells(9, a).Value = Sheets(FNomDuMois$(i + 1)).Cells(Z, a).Value
End If
If a = 33 Then
Z = Z + 1
End If
Next a
Code1_activate
impsem
SelectSurJourEnCours
End Sub