Vba Kodunu Çoklama

[fatih198605]

Değerli ustalarım,

Aşağıdaki kodu aynı workbookta b sütunu ve örnek2 sayfası için de kullanmak istiyorum. a sutunundaki hücreye çift tıkladığımda örnek sayfasından açıyor. B sutununa çift tıkladığıda ise örnek 2 sayfasından yeni sayfa olustursun istiyorum. Yardımınızı rica ederim.

Private Sub Workbook_SheetBeforeDoubleClick(ByVal sh As Object, ByVal Target As Range, Cancel As Boolean)
On Error GoTo Son
Dim Sayfa As String

If Intersect(Target, [A2:A65536]) Is Nothing Then Exit Sub

Sayfa = Target.Value
If Sayfa <> "" Then Sheets(Sayfa).Select

Exit Sub
Son:

Sordum = MsgBox(Target.Value & " Adlı sayfa yok,Açılsın mı? ", vbYesNo, Target.Value & " fy")

If Sordum = vbYes Then
Sheets("örnek").Copy After:=Sheets(Sheets.Count)
ActiveSheet.Name = Target.Value
MsgBox Target.Value & " Açıldı......", vbOKOnly, "fy"
End If

End Sub

 

[Ömer]

Merhaba,

Bu şekilde deneyin.

Private Sub Workbook_SheetBeforeDoubleClick(ByVal sh As Object, ByVal Target As Range, Cancel As Boolean)
On Error GoTo Son
Dim Sayfa As String

If Intersect(Target, [A2:B65536]) Is Nothing Then Exit Sub 'A:B olarak değişti.

Sayfa = Target.Value
If Sayfa <> "" Then Sheets(Sayfa).Select

Exit Sub
Son:

Sordum = MsgBox(Target.Value & " Adlı sayfa yok,Açılsın mı? ", vbYesNo, Target.Value & " fy")

If Sordum = vbYes Then
If Target.Column = 1 Then 'ilave
    Sheets("örnek").Copy After:=Sheets(Sheets.Count)
Else 'ilave
    Sheets("örnek2").Copy After:=Sheets(Sheets.Count) 'ilave
End If 'ilave
ActiveSheet.Name = Target.Value
MsgBox Target.Value & " Açıldı......", vbOKOnly, "fy"
End If

End Sub

 

[fatih198605]

Teşekkürler. İstediğim gibi çalışıyor.