verifier une cellule et boucle

For a = 3 To 33
' supprimer la condition If Cells(7, 3).Value = "" Then
Cells(7, a).Value = IIf(a <> 33, Sheets(FNomDuMois$(i)).Cells(Z, a).Value, Sheets(FNomDuMois$(i)).Cells(Z + 1, a).Value)
Next a

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