Sub WsLock(Optional Y)
Dim PWd$
PWd = ""
Application.ScreenUpdating = False
If IsMissing(Y) Then
For i = 1 To Worksheets.Count
Worksheets(i).Protect PWd
[A1].Select
Next
Else
For i = 1 To Worksheets.Count
Worksheets(i).Unprotect PWd
[A1].Select
Next
End If
End Sub
Sub protege()
WsLock
End Sub
Sub DeverouillerCellulesVides()
'Commence par tout vérouiller
With Sheets("Sem1")
.Unprotect ""
With Intersect(.UsedRange, .Range("A1:J3000"))
.Cells.Locked = True
'On Error Resume Next
.SpecialCells(xlCellTypeBlanks).Locked = False
End With
For Each c In Sheets("Sem1").Range("A1:J3000")
If c <> "" Then
If c.MergeCells Then
c.MergeArea.Locked = True
End If
If IsEmpty(Range("A1").MergeArea) Then
Range("Sem1!A1").MergeArea.Locked = False
End If
End If
Next
.Protect ""
End With
With Sheets("Sem2")
.Unprotect ""
With Intersect(.UsedRange, .Range("A1:J3000"))
.Cells.Locked = True
'On Error Resume Next
.SpecialCells(xlCellTypeBlanks).Locked = False
End With
For Each c In Sheets("Sem2").Range("A1:J3000")
If c <> "" Then
If c.MergeCells Then
c.MergeArea.Locked = True
End If
If IsEmpty(Range("A1").MergeArea) Then
Range("Sem2!A1").MergeArea.Locked = False
End If
End If
Next
.Protect ""
End With
With Sheets("Sem3")
.Unprotect ""
With Intersect(.UsedRange, .Range("A1:J3000"))
.Cells.Locked = True
'On Error Resume Next
.SpecialCells(xlCellTypeBlanks).Locked = False
End With
For Each c In Sheets("Sem3").Range("A1:J3000")
If c <> "" Then
If c.MergeCells Then
c.MergeArea.Locked = True
End If
If IsEmpty(Range("A1").MergeArea) Then
Range("Sem3!A1").MergeArea.Locked = False
End If
End If
Next
.Protect ""
End With
With Sheets("Sem4")
.Unprotect ""
With Intersect(.UsedRange, .Range("A1:J3000"))
.Cells.Locked = True
'On Error Resume Next
.SpecialCells(xlCellTypeBlanks).Locked = False
End With
For Each c In Sheets("Sem4").Range("A1:J3000")
If c <> "" Then
If c.MergeCells Then
c.MergeArea.Locked = True
End If
If IsEmpty(Range("A1").MergeArea) Then
Range("Sem4!A1").MergeArea.Locked = False
End If
End If
Next
.Protect ""
End With
End Sub