Merhaba üstadlar,

Ben ekte bir örnek İş Emri Açma excel'i oluşturdum.

A4,A5,A6.... hücrelerine çift tıkladığımda yeni bir sheet açabiliyorum, fakat tüm sheetler(Genel Şablon Sheet'im İş Emri) aynı içerikte oluyor.

Yapmak istediğimi A4 hücresine çift tıkladığımda 4 satırındaki bilgileri alıp yeni bir sheet oluştursun, A5 hücresine çift tıkladığımda 5 satırındaki bilgileri alıp yeni bir sheet oluştursun. Genel Şablonum İş Emri Sheet'idir.
Yardımlarınız için teşekkür ederim.

yalnız sizin yaptığınız sadece işemrinin kopyasını oluşturmak ve is emri de sabit hücrelere bağlı
kodu aşağıdaki gibi dener misini 2 satır ekledim onları eklemeniz yeter

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

On Error GoTo Son

Dim Sayfa As String

Dim ts

AktifHucre = ActiveCell.Row  '<=== bu satır tıklanan hücrenin satır bilgisini alıyor

If ActiveSheet.Name <> "W.O KAYIT" Then



Else

    Sayfa = Target.Value

    If Sayfa <> "" Then Sheets(Sayfa).Select

End If

Exit Sub

Son:

If Intersect(Target, Sheets("W.O KAYIT").Range("A4:A23000")) Is Nothing Then Exit Sub

Sordum = MsgBox(Target.Value & " Numaralı İş Emri A4 Formatına Uygun Açılıyor", vbYesNo, "                               Değerli Çalışan   ")

If Sordum = vbYes Then

    Sheets("İŞ EMRİ").Copy After:=Sheets(Sheets.Count)

    ActiveSheet.Name = Target.Value

    Worksheets(Target.Value).Range("A1:Z100").Replace "4", AktifHucre '<== bu satır yeni sayfanın kodlarını ='W.O KAYIT'!C4 sadece 4  değerini aktif hücrenin satır nosu ile değiştiriyor

    MsgBox Target.Value & " Numaralı İş Emri A4 Formatına Uygun Açıldı", vbOKOnly, "                               Değerli Çalışan    "

ts = "B2"

Range(ts) = ActiveSheet.Name

End If

End Sub

(29/04/2019, 20:18)haliliyas yazdı: yalnız sizin yaptığınız sadece işemrinin kopyasını oluşturmak ve is emri de sabit hücrelere bağlı
kodu aşağıdaki gibi dener misini 2 satır ekledim onları eklemeniz yeter

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

On Error GoTo Son

Dim Sayfa As String

Dim ts

AktifHucre = ActiveCell.Row  '<=== bu satır tıklanan hücrenin satır bilgisini alıyor

If ActiveSheet.Name <> "W.O KAYIT" Then



Else

    Sayfa = Target.Value

    If Sayfa <> "" Then Sheets(Sayfa).Select

End If

Exit Sub

Son:

If Intersect(Target, Sheets("W.O KAYIT").Range("A4:A23000")) Is Nothing Then Exit Sub

Sordum = MsgBox(Target.Value & " Numaralı İş Emri A4 Formatına Uygun Açılıyor", vbYesNo, "                               Değerli Çalışan   ")

If Sordum = vbYes Then

    Sheets("İŞ EMRİ").Copy After:=Sheets(Sheets.Count)

    ActiveSheet.Name = Target.Value

    Worksheets(Target.Value).Range("A1:Z100").Replace "4", AktifHucre '<== bu satır yeni sayfanın kodlarını ='W.O KAYIT'!C4 sadece 4  değerini aktif hücrenin satır nosu ile değiştiriyor

    MsgBox Target.Value & " Numaralı İş Emri A4 Formatına Uygun Açıldı", vbOKOnly, "                               Değerli Çalışan    "

ts = "B2"

Range(ts) = ActiveSheet.Name

End If

End Sub

Hocam yazdığınız kod problemsiz çalıştı. Çok teşekkür ederim değerli vaktinizi harcadığınız için.
Emeğinize sağlık.

saygılar

Önemli değil iyi çalışmalar )