Protection d'une feuille dans classeur

Nitrog

XLDnaute Junior
Bonjour le Forum, Je me permets de vous soliciter pour résoudre mon problème de protection d'une feuille que je n'arrive pas à trouver.
Mon but est de protéger la feuille ("1") qui est masquée contre toutes modifications, j'arrive facilement à enlever le code à l'ouverture, mais j'ai un message d'erreur lorsque je lance la macro et la feuille ("1") reste ouverte.
Je pense que je ne dois pas mettre "protect" au bon endroit.

Ci-dessous le code

Sub Copier()
'
' Copier Macro
Macro enregistrée le 13.02.2011

Sheets("1").Unprotect "toto"

Application.ScreenUpdating = False
Dim fichier
ChDrive "C:"
ChDir "C:\ko\date"
fichier = Application.GetOpenFilename("Excel fichiers (*.xls),(*.xlsm) *.xlsb")
If fichier <> False Then
Workbooks.Open (fichier)
End If
Cells.Select
Selection.Copy
Windows("SoExcel.xlsm").Activate
Sheets("Ko").Select
Range("a1").Select
ActiveSheet.Paste

' Calcul_1

Range("CP4").FormulaR1C1 = "=+RC53+RC54"
Range("CP4").Copy Range("CP5:CP500")
Columns("CP:CP").NumberFormat = "#,##0.00"

' Calcul_2

Range("CN4").FormulaR1C1 = "=+RC47-RC65"
Range("CN4").Copy Range("CN5:CN500")
Columns("CN:CN").NumberFormat = "#,##0.00"

' Calcul_3

Range("CO4").FormulaR1C1 = "=+RC48-RC66"
Range("CO4").Copy Range("CO5:CO500")
Columns("CO:CO").NumberFormat = "#,##0.00"

' Calcul_4

Range("CM4").FormulaR1C1 = "=ROUND((RC38/1.02)+(rc37-RC38)/1.0225,1)"
Range("CM4").Copy Range("CM5:CM500")
Columns("CM:CM").NumberFormat = "#,##0.00"
Range("a1").Select

'Copie 1 sur 2


Sheets("1").Visible = True
Sheets("1").Select
Range("A1:CP502").Select
Selection.Copy

Workbooks.Open Filename:="C:\lo\NewsKo\2.xls"
Sheets("2").Select
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("A1").Select

'Supprimer ligne vides et Colonnes

Dim c As Integer
Application.ScreenUpdating = False
With Sheets("2")
For x = .Range("A502").End(xlUp).Row To 1 Step -1
If .Range("A" & x) = 0 Then
Rows(x).Delete
Else
Exit For
End If
Next
For c = 94 To 1 Step -1
If Cells(3, c).Value = 0 Then Cells(3, c).EntireColumn.Delete
Next c
Application.ScreenUpdating = True
End With
Rows("503:503").Cut
Cells.Find(What:="End", After:=Range("A2"), LookIn:=xlFormulas, _
LookAt:=xlWhole, SearchOrder:=xlByColumns, _
SearchDirection:=xlNext, MatchCase:=False).Activate
ActiveSheet.Paste
Range("A1").Select
Application.DisplayAlerts = False
MsgBox "Merci de sauvegarder !!"
Application.ScreenUpdating = True

Sheets("1").Select
Range("a1").Select erreur d'éxécution 9
Sheets("1").Protect "toto" l'indice n'appartien pas à la sélection
ActiveWindow.SelectedSheets.Visible = False

End Sub

Je vous remercie pour votre aide

Nitrog
 

Discussions similaires

Réponses
5
Affichages
130
Réponses
2
Affichages
123

Membres actuellement en ligne

Statistiques des forums

Discussions
312 229
Messages
2 086 426
Membres
103 206
dernier inscrit
diambote