aşağıda vereceğim formül ile a sutunundaki hücreye girilen değer göre yeni eklenen sayfaya tutanak sayfasını kopyalıyorum.
ancak kupyalanan tutanak sayfasının sadece biçim ve değer ile kopyalamak istiyorum (yani formüllerin kopyalanmasını istemiyorum)
yardımcı olanlara şimdiden teşekkür.
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
If Not Application.Intersect(Target, Range("a:b")) Is Nothing Then
ActiveSheet.Unprotect Password:="abdullah"
Target(1).Value = UCase(Target(1).Value)
End If
Application.EnableEvents = True
Application.ScreenUpdating = False
On Error Resume Next
If Target.Column <> 1 Or Target.Value = "" Then Exit Sub
On Error GoTo Devam
Sheets(Target.Text).Select
MsgBox "BU SAYILI TUTANAK MEVCUTTUR! YENİ BİR SAYI GİRİN...", vbCritical
Sheets("veri").Select
Target.Select
Application.ScreenUpdating = True
Exit Sub
Devam:
Sheets("tutanak").Copy After:=Sheets(Sheets.Count)
Sheets(Sheets.Count).Name = Target.Text
Sheets("kayıt").Select
Range("A2:A1001").Select
ActiveSheet.Unprotect Password:="abdullah"
Selection.Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
ActiveSheet.Protect Password:="abdullah", DrawingObjects:=True, Contents:=True, Scenarios:=True
Range("A2").Select
Do While Not IsEmpty(ActiveCell)
ActiveCell.Offset(1, 0).Select
Loop
Application.ScreenUpdating = True
If Target.Row < 10 Then Exit Sub
If Target.Column <> 1 Then Exit Sub
End Sub
ancak kupyalanan tutanak sayfasının sadece biçim ve değer ile kopyalamak istiyorum (yani formüllerin kopyalanmasını istemiyorum)
yardımcı olanlara şimdiden teşekkür.
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
If Not Application.Intersect(Target, Range("a:b")) Is Nothing Then
ActiveSheet.Unprotect Password:="abdullah"
Target(1).Value = UCase(Target(1).Value)
End If
Application.EnableEvents = True
Application.ScreenUpdating = False
On Error Resume Next
If Target.Column <> 1 Or Target.Value = "" Then Exit Sub
On Error GoTo Devam
Sheets(Target.Text).Select
MsgBox "BU SAYILI TUTANAK MEVCUTTUR! YENİ BİR SAYI GİRİN...", vbCritical
Sheets("veri").Select
Target.Select
Application.ScreenUpdating = True
Exit Sub
Devam:
Sheets("tutanak").Copy After:=Sheets(Sheets.Count)
Sheets(Sheets.Count).Name = Target.Text
Sheets("kayıt").Select
Range("A2:A1001").Select
ActiveSheet.Unprotect Password:="abdullah"
Selection.Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
ActiveSheet.Protect Password:="abdullah", DrawingObjects:=True, Contents:=True, Scenarios:=True
Range("A2").Select
Do While Not IsEmpty(ActiveCell)
ActiveCell.Offset(1, 0).Select
Loop
Application.ScreenUpdating = True
If Target.Row < 10 Then Exit Sub
If Target.Column <> 1 Then Exit Sub
End Sub
