Sayfa isminin hücreye yazdırılması

[manisali50]

Arkadaşlar merhaba..
Sayfa isminin benim belirlediğim bir hücreye yazdırılması ile ilgili sorum ektedir..
Şimdiden teşekkürler

 

[Ömer]

Merhaba,

Eski kodların yerine;

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, _
ByVal Target As Range)
 
syf1 = "(0)ARA KONTROL FORMU(1)"
syf2 = "(0)ARA KONTROL FORMU(2)"
 
With ActiveSheet
    If .Name = syf1 Or .Name = syf2 Then Exit Sub
    Range("H5") = Split(.Name, "-")(0)
    Range("H7") = Split(.Name, "-")(1)
End With
 
End Sub

.

 

[manisali50]

Dostum çok ama çok teşekkürler.Tam istediğim gibi olmuş..Şöyle ufak bir sorun var..Bu klasörün içerinde "BENİ OKU" diye programın işleyişini anlatan bir sayfa vardı..O sayfada ne işlem yaparsak yapalım Run-time error:9 Subscript out of range hatası veriyor.End deyip işleme devam ediyorum ama her işlemden sonra çıkıyor karşıma..Ne yapabilirim?

 

[Ömer]

Kodları görmeden net birşey söylemem güç,

Komut ile hataları atlayabilirsiniz.

On Error Resume Next

 

[manisali50]

Bütün kodlar şöyle :
(0)ARA KONTROL FORMU(1) SAYFASI
Private Sub Worksheet_Change(ByVal Target As Range)

If Target.Count > 1 Then Exit Sub

If Not Intersect(Target, Range("H3")) Is Nothing Then Range("Y3").Select
If Not Intersect(Target, Range("Y3")) Is Nothing Then Range("P5").Select
If Not Intersect(Target, Range("P5")) Is Nothing Then Range("Y5").Select
If Not Intersect(Target, Range("Y5")) Is Nothing Then Range("P7").Select
If Not Intersect(Target, Range("P7")) Is Nothing Then Range("Y7").Select
If Not Intersect(Target, Range("Y7")) Is Nothing Then Range("D11").Select


End Sub
Sub NeuesTabBlatt()
Dim NewName As String
ActiveSheet.Copy Before:=Sheets(1) 'ganz links anordnen
'ActiveSheet.Copy Before:=ActiveSheet 'links neben Original anordnen
NewName = InputBox("Lütfen Çoğaltılacak Sayfanın İsmini Giriniz")
On Error Resume Next
ActiveSheet.Name = NewName
End Sub

(0)ARA KONTROL FORMU(2) SAYFASI
Private Sub Worksheet_Change(ByVal Target As Range)

If Target.Count > 1 Then Exit Sub

If Not Intersect(Target, Range("H3")) Is Nothing Then Range("Y3").Select
If Not Intersect(Target, Range("Y3")) Is Nothing Then Range("P5").Select
If Not Intersect(Target, Range("P5")) Is Nothing Then Range("Y5").Select
If Not Intersect(Target, Range("Y5")) Is Nothing Then Range("P7").Select
If Not Intersect(Target, Range("P7")) Is Nothing Then Range("Y7").Select
If Not Intersect(Target, Range("Y7")) Is Nothing Then Range("D11").Select


End Sub
Sub NeuesTabBlatt()
Dim NewName As String
ActiveSheet.Copy Before:=Sheets(1) 'ganz links anordnen
'ActiveSheet.Copy Before:=ActiveSheet 'links neben Original anordnen
NewName = InputBox("Lütfen Çoğaltılacak Sayfanın İsmini Giriniz")
On Error Resume Next
ActiveSheet.Name = NewName
End Sub

ThisWorkbook Sayfası :
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, _
ByVal Target As Range)

syf1 = "(0)ARA KONTROL FORMU(1)"
syf2 = "(0)ARA KONTROL FORMU(2)"

With ActiveSheet
If .Name = syf1 Or .Name = syf2 Then Exit Sub
Range("H5") = Split(.Name, "-")(0)
Range("H7") = Split(.Name, "-")(1)
On Error Resume Next

End With

End Sub

Burada Range("H7") = Split(.Name, "-")(1) satırı sarı renge boyanıyor

 

[manisali50]

Arkadaşlar merhaba..Ömer üstadım forumdan ayrılmış sanırım..Yardımcı olacak arkadaşların ilgi ve yardımlarını bekliyorum

 

[manisali50]

Yardımcı olacak arkadaş olur düşüncesiyle sorumu güncelliyorum

 

[Ömer]

Hatayı aldığınız dosyayı eklemeniz mümkün mü?

.

 

[manisali50]

Hemen yolluyorum hocam..

 

[Ömer]

VBA da şifre var.

 

[Ömer]

Ölçüte girmeyen sayfa sayısı 2 demiştiniz. Diğerlerinide ekledim.

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, _
ByVal Target As Range)
 
syf1 = "(0)ARA KONTROL FORMU(1)"
syf2 = "(0)ARA KONTROL FORMU(2)"
[COLOR=red]syf3 = "(0)(A)BENİ OKU"
syf4 = "(0)ANA SAYFA"[/COLOR]
 
With ActiveSheet
    If .Name = syf1 Or .Name = syf2 [COLOR=red]Or .Name = syf3 _
    Or .Name = syf4[/COLOR] Then Exit Sub
    
    Range("H5") = Split(.Name, "-")(0)
    Range("H7") = Split(.Name, "-")(1)
    
End With
 
End Sub

.

 

[manisali50]

İşte bu kadar..Çok çok çok çok teşekkür ederim..İlginize,bilgine,emeğinize,YÜREĞİNİZE sağlık..