Sub Archivage()
'Désactive la mise à jour écran
Application.ScreenUpdating = False
Dim Date_Jour As Range, Equipe As Range, Poste As Range, Nom As Range
Dim t() As Variant, i As Integer
Dim MSG As Long
'Liste des lignes à contrôler si remplies
t = Array(13, 14, 15, 16, 17, 18, 19, 21, 22, 23, 24, 25, 26)
With Sheets("Saisie")
'Contrôle si effectif mini présent
If .Range("R18").Value < "10" Then
'Message erreur si effectif mini non atteint
MSG = MsgBox("L'effectif n'est pas complet, vérifier la saisie dans le tableau.", vbExclamation, "Effectif incomplet")
'Fin Macro
Exit Sub
Else
'Défini Date à archiver et quelle équipe et quel poste
Set Date_Jour = .Range("A2")
Set Poste = .Range("A7")
Set Equipe = .Range("A9")
'Boucle sur les lignes à archiver si effectif présent
For i = LBound(t) To UBound(t)
If .Range("H" & t(i)).Value = "1" Then
Set Nom = .Range("A" & t(i))
[B]BLOQUE ICI[/B]
End If
Next i
End If
End With
End Sub