Soru Şablon Sayfasını Kopyalama

Katılım
29 Ocak 2020
Mesajlar
6
Excel Vers. ve Dili
Excel 2016 Türkçe
Altın Üyelik Bitiş Tarihi
13-02-2021
S.A. Arkadaşlar

Bir konuda yardımlarınıza ihtiyacım var .

Excelweb ailesini takip ederek kendi işime yarayacak stok ve cari takip etme programı yaptım bunu içinde buradaki paylaşımlardan alıntılar yaparak çalıştım
eklemiş olduğum excel dosyasında stok ve cari sütunları var veri doğrulama kullanarak cari yada stok kodunu getiriyorum yeni bir cari eklersem şabloncari diye bir sayfa yaptım ve otomatik olarak yeni bir cari eklersem bana bu carinin sayfası olmadığını uyararak sayfa açtırıyor bu işlemin aynısını stoklarda da kullanmak istiyorum biraz kurcaladım ve yapamayınca yardımlarınıza ihtiyaç duydum şimdiden teşekkür ederim yardımlar için .
 

Ekli dosyalar

Ömer

Moderatör
Yönetici
Katılım
18 Ağustos 2007
Mesajlar
22,183
Excel Vers. ve Dili
Microsoft 365 Tr
Ofis 2016 Tr
Merhaba,

BuçalışmaKitabı sayfasındaki Workbook_SheetBeforeDoubleClick kodlarını aşağıdakilerle değiştirin.
Eklenen, C sütununa göre "STOK" sayfasını şablon olarak belirleyip yeni sayfa açma. Şablon sayfası farklı olacaksa kendinize uyarlarsınız.

Kod:
Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)

    On Error GoTo son
    Dim Sayfa As String
    If ActiveSheet.Name = "ANASAYFA" Then
        Sayfa = Target.Value
        If Sayfa <> "" Then
            Sheets(Sayfa).Visible = True
            Sheets(Sayfa).Select
        End If
    End If
    Exit Sub
son:

    If Not Intersect(Target, Sheets("ANASAYFA").Range("E2:E65536")) Is Nothing Then
        sor = MsgBox(Target.Value & " Adlı Sayfa Yok, Eklemek İster Misiniz? ", vbYesNo, Target.Value & " Adlı Sayfanın Açılması")
        If sor = vbYes Then
            Sheets("ŞABLONCARİ").Visible = True
            Sheets("ŞABLONCARİ").Copy After:=Sheets(Sheets.Count)
            ActiveSheet.Name = Target.Value
            ActiveSheet.Visible = False
            Sheets("ŞABLONCARİ").Visible = False
        End If
    End If
    
    If Not Intersect(Target, Sheets("ANASAYFA").Range("C2:C65536")) Is Nothing Then
        sor = MsgBox(Target.Value & " Adlı Sayfa Yok, Eklemek İster Misiniz? ", vbYesNo, Target.Value & " Adlı Sayfanın Açılması")
        If sor = vbYes Then
            Sheets("STOK").Visible = True
            Sheets("STOK").Copy After:=Sheets(Sheets.Count)
            ActiveSheet.Name = Target.Value
            ActiveSheet.Visible = False
            Sheets("STOK").Visible = False
        End If
    End If
    
End Sub
 
Üst