sayfa koruma

[hüseyin551]

sayfa koruma yaptığımda makro çalışmıyor. önceki yazışmalara baktım.kopyala yapıştırma yaptım olmadı
makroyu aşağıya kopyalıyorum.ilginiz için teşekkürler. b9 f9 g9 k9 l9 çalışmasını istiyorum.

Private Sub CommandButton1_Click()
Sayfa10.PrintPreview
End Sub

Private Sub CommandButton2_Click()
Sayfa10.PrintOut Copies:=1
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Alan As String
If Intersect(Target, [B9,f9,g9,k9,l9]) Is Nothing Or Target.Cells.Count > 1 Then Exit Sub
Application.EnableEvents = False
Cancel = True
If Target.Value <> "" Then

sut = Target.Column + 0
If Cells(1, sut) = "" Then
Cells(1, sut) = Target.Value
Else
If Cells(Rows.Count, sut) = Empty Then
If Not Intersect(Target, [B9]) Is Nothing Then
Alan = "A13:C13"
ElseIf Not Intersect(Target, [F9]) Is Nothing Then
Alan = "D13:I13"
ElseIf Not Intersect(Target, [K9]) Is Nothing Then
Alan = "J13:O13"
End If
If Not Intersect(Target, [B9,F9,K9]) Is Nothing Then
Range(Alan).Insert Shift:=xlDown
Rows("14:14").Copy
Rows("13:13").PasteSpecial Paste:=xlPasteFormats
Application.CutCopyMode = False
Range("C14").Copy Range("C13")
Range("E14").Copy Range("E13")
Range("H14:I14").Copy Range("H13")
Range("M14:O14").Copy Range("M13")
Range("T14:U14").Copy Range("T13")
End If
sat = 12
Cells(sat + 1, sut) = Target.Value
If sut = 2 Then
Cells(sat + 1, sut - 1) = Format(Now, "dd.mm.yyyy")
ElseIf sut = 6 Then
Cells(sat + 1, sut - 2) = Format(Now, "dd.mm.yyyy")
ElseIf sut = 11 Then
Cells(sat + 1, sut - 1) = Format(Now, "dd.mm.yyyy")
End If
Else
MsgBox Choose(sut / 9, "B", "F", "G", "K", "L") & " Sütunu doldu.", vbCritical
End If
End If
Target.Value = ""
Target.Select
End If
Application.EnableEvents = True
End Sub
ActiveSheet.Unprotect "55"
ActiveSheet.Protect "55"

ActiveSheet.Protect Password:="55", DrawingObjects:=True, Contents:=True, Scenarios:=True _
, AllowSorting:=True, AllowFiltering:=True

 

[EmrExcel16]

Deneyiniz

Private Sub CommandButton1_Click()
Sayfa10.PrintPreview
End Sub

Private Sub CommandButton2_Click()
Sayfa10.PrintOut Copies:=1
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Alan As String
If Intersect(Target, [B9,f9,g9,k9,l9]) Is Nothing Or Target.Cells.Count > 1 Then Exit Sub
ActiveSheet.Unprotect "55"
Application.EnableEvents = False
Cancel = True
If Target.Value <> "" Then

sut = Target.Column + 0
If Cells(1, sut) = "" Then
Cells(1, sut) = Target.Value
Else
If Cells(Rows.Count, sut) = Empty Then
If Not Intersect(Target, [B9]) Is Nothing Then
Alan = "A13:C13"
ElseIf Not Intersect(Target, [F9]) Is Nothing Then
Alan = "D13:I13"
ElseIf Not Intersect(Target, [K9]) Is Nothing Then
Alan = "J13:O13"
End If
If Not Intersect(Target, [B9,F9,K9]) Is Nothing Then
Range(Alan).Insert Shift:=xlDown
Rows("14:14").Copy
Rows("13:13").PasteSpecial Paste:=xlPasteFormats
Application.CutCopyMode = False
Range("C14").Copy Range("C13")
Range("E14").Copy Range("E13")
Range("H14:I14").Copy Range("H13")
Range("M14:O14").Copy Range("M13")
Range("T14:U14").Copy Range("T13")
End If
sat = 12
Cells(sat + 1, sut) = Target.Value
If sut = 2 Then
Cells(sat + 1, sut - 1) = Format(Now, "dd.mm.yyyy")
ElseIf sut = 6 Then
Cells(sat + 1, sut - 2) = Format(Now, "dd.mm.yyyy")
ElseIf sut = 11 Then
Cells(sat + 1, sut - 1) = Format(Now, "dd.mm.yyyy")
End If
Else
MsgBox Choose(sut / 9, "B", "F", "G", "K", "L") & " Sütunu doldu.", vbCritical
End If
End If
Target.Value = ""
Target.Select
End If
ActiveSheet.Protect Password:="55", DrawingObjects:=True, Contents:=True, Scenarios:=True _
, AllowSorting:=True, AllowFiltering:=True
Application.EnableEvents = True
End Sub

 

[hüseyin551]

teşekkür ederim.emeğine saglık

 

[EmrExcel16]

Rica ederim , iyi çalışmalar.