aynı sayfa adı varsa

[burhancavus61]

aynı sayfa adı varsa kopyalam işlemini iptal etsin. Ben aşağıdaki kodu kullanıyorum hata oluyor.

    For a = 1 To Sheets.Count
    ActiveSheet.Name = [V2] & "-" & [AC2]
    sor = MsgBox("Aynı Puantaj adı mevcuttur. Arşivlenen Puantajı silip tekrar deneyiniz..!", 20, "SON UYARI")
    If sor = vbNo Then Exit Sub
    Next

 

[Ömer]

Merhaba,

Sorunuz anlaşılmıyor. Linkte sayfa kontrolü ile ilgili kodlar mevcut. İnceleyin. #3 numaralı mesaj.

Hücrelerdeki isimlere göre sayfa oluşturma

Kısa bir sorum olacaktı Sayfa1 deki A1:A50 arasındaki hücrelerde yazılı olan isimleri nasıl bir makro ile sayfa yapabilirim. Örnek: A1= can olsun makro çalıştığında can isimli bir sayfa oluştursun A2= ali olsun makro çalıştığında ali isimli bir sayfa oluştursun Soru kısa olduğundan örnek...

www.excel.web.tr

.

 

[burhancavus61]

Bana uygun değil gibi hocam. şablondan sayfa kopyalayıp yeniden adlandırıyorum. eğer adlandırdığım sayfa adının aynısı varsa sayfa kopyalama işlemi iptal olmalı. yoksa kopyalama işlemi yapılmalı.

 

[Ömer]

Yapmak istediğinizle ilgili küçük bir örnek dosya ekler misiniz.

 

[burhancavus61]

Ekledim hocam açıklamada yazdım

 

[Ömer]

Kodları aşağıdakilerle değiştirerek deneyin.

Sub PuantajTası()
    
'Puantaj Taşıma
    Sheets("Puantaj").Select
    
    If varmi([C2] & "-" & [D2]) Then
        MsgBox "Bu Sayfa Adı Var"
        Exit Sub
    End If
  
    Sheets("Puantaj").Copy After:=Worksheets(Worksheets.Count)
'Sayfa Adlandırma
'    For a = 1 To Sheets.Count
    ActiveSheet.Name = [C2] & "-" & [D2]
'    sor = MsgBox("Aynı Puantaj adı mevcuttur. Arşivlenen Puantajı silip tekrar deneyiniz..!", 20, "SON UYARI")
'    If sor = vbNo Then Exit Sub
'    Next
'Formülleri Kaldırma
    Cells.Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("K6").Select
'---------------------------------------------------------------------
'SAYFANIN MAKROLARINI SİLME
'        Dim VBCodeMod
'        Set DimVBCodeMod = ThisWorkbook.VBProject.VBComponents(ActiveSheet.Name).CodeModule
'        VBCodeMod.DeleteLines 1, VBCodeMod.CountOfLines
'---------------------------------------------------------------------
    Sheets("Giriş").Select
    Range("D4").Select
End Sub

Function varmi(adi As String) As Boolean
    On Error Resume Next
    varmi = CBool(Len(Worksheets(adi).Name) > 0)
End Function

 

[burhancavus61]

Teşekkür ederim hocam sonunda halloldu.

 

[Andermin]

Merhabalar Hocam. Vba macro ile otomatik farklı isimlerde sayfalar oluşturmak istiyorum. Aynı isimde sayfa varsa diğerine geçmesini istiyorum. Bir nevi kontrol için kullanacağım. Olmayan sayfayı ilave etmesi için. Yardımcı olursanız sevinirim. Şimdiden teşekkürler.

 

[Necdet]

Merhaba,

Aşağıdaki kodları kendinize uyarlayınız.

Public Sub deneme()

Dim sayfaAdi As Variant
Dim syf As Worksheet

Set syf = ActiveSheet

Application.ScreenUpdating = False

sayfaAdi = Application.InputBox("Sayfa Adını Giriniz", Type:=2)
If sayfaAdi = False Then Exit Sub

If varmi(CStr(sayfaAdi)) = False Then
    Sheets.Add after:=Sheets(Sheets.Count)
    ActiveSheet.Name = sayfaAdi
    MsgBox sayfaAdi & " sayfası açılmıştır...."
    syf.Select
Else
    MsgBox "sayfa var, açılamaz....", vbCritical
End If
Application.ScreenUpdating = True

End Sub

Function varmi(adi As String) As Boolean
    On Error Resume Next
    varmi = CBool(Len(Worksheets(adi).Name) > 0)
End Function

 

[Andermin]

Çok teşekkür ederim. Deniyorum makroyu. Şöyle bir sorunum var. Olan bir sayfa adında hata çıkmasından ziyade yok sayarak olmayan sayfa ismine göre açmaya devam nasıl ettirebilirim ?

 

[Andermin]

Kusurabakmayın çok acemi olduğum için sizi uğraştırıyorum. Aslında basit ama ben macroya biraz uzağım. Aşağıdaki gibi sayfaları çoğaltırken aynı isimde sayfa var ise hiçbirşey yapmadan diğerine geçerek olmayanlarını açmasını istiyorum sadece. Teşekkürler.

Sub sayfa()
'
' sayfa Makro
'

'
    Sheets("Genel").Select
    Sheets("Genel").Copy After:=Sheets(1)
    Sheets("Genel (2)").Select
    Sheets("Genel (2)").Name = "adem"
    Sheets("Genel").Select
    
    Sheets("Genel").Select
    Sheets("Genel").Copy After:=Sheets(1)
    Sheets("Genel (2)").Select
    Sheets("Genel (2)").Name = "adem"
    Sheets("Genel").Select
    
    Sheets("Genel").Select
    Sheets("Genel").Copy After:=Sheets(1)
    Sheets("Genel (2)").Select
    Sheets("Genel (2)").Name = "bdem"
    Sheets("Genel").Select
    
    
End Sub