Sub extraire_lundi()
Dim i As Long
Dim j As Long
'Dim k As Long
Dim NomSem As String
NomSem = ActiveSheet.Name
Sheets("extraction").Select
Range("a2:j65000").Select
Selection.ClearContents
Sheets(NomSem).Activate
'je déprotège ma feuille
ActiveSheet.Unprotect Password:="****"
For i = 4 To 107
If Cells(i, 2) = "fin" Then Exit Sub
Sheets(NomSem).Select
Range(Cells(i, 2), Cells(i, 9)).copy
Sheets("extraction").Select
For j = 2 To 65536
If Cells(j, 3) = "" Then
Cells(j, 3).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Cells(j, 1) = Sheets(NomSem).Range("bf1")
Cells(j, 2) = Sheets(NomSem).Range("b1")
Sheets(NomSem).Select
Exit For
Else
Cells(j + 1, 3).Select
End If
Next j
Cells(i + 1, 2).Select
Next i
'Next k
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, Password:="****"
End Sub