Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

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
174
Réponses
2
Affichages
145
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…