• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

a sutununa girilen değer isminde sayfa ekleme

Katılım
14 Şubat 2005
Mesajlar
137
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
 
Geri
Üst