Sub Transfert()
Dim Mois As Byte, dteJour As Byte, txtJour As String, NbJours As Byte, Annee As Integer
Dim ColSem As Byte
Dim lgVille As Object, Ville As String, Agent As String
tbJours = Array("Lundi", "Mardi", "Mercredi", "Jeudi", "Vendredi", "Samedi", "Dimanche")
Annee = Sheets("ACCUEIL").Range("D3")
ColSem = 2
On Error Resume Next
For Mois = 1 To 12
With Sheets(MonthName(Mois))
NbJours = CDate("1/" & Mois + 1 & "/" & Annee) - CDate("1/" & Mois & "/" & Annee)
For j = 1 To NbJours
dteJour = Weekday(CDate(j & "/" & Mois & "/" & Annee), 2)
txtJour = tbJours(dteJour - 1)
Set lgVille = Sheets("ACCUEIL").Range("A30:A37").Find(txtJour, LookIn:=xlValues, lookat:=xlWhole)
If Not lgVille Is Nothing Then Ville = Sheets("ACCUEIL").Cells(lgVille.Row, 2)
... Code à insérer ici par la suite ...
Next
ColSem = ColSem + 1
If ColSem = 8 Then ColSem = 2
End With
Next
End Sub