• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Sütuna göre sayfa silme

Y

yanginci34

Altın Üye
Katılım
6 Temmuz 2010
Mesajlar
1,673
Excel Vers. ve Dili
excel2016
Merhaba arkadaşlar; Benim sizlerin yardımı ile hazırladığım dosyada İCMAL sayfası A sütununa isim yazdığımda otomatik o isimde sayfa açıyor isteğime gelince bu A sütunundan ismi sildigimde sayfasını da silebilirmiyiz. Şimdiden teşekkürler.
 
Merhaba.

Aşağıdaki kodları kullanın.

Kod: 
Dim Hucre As Range
Dim SayfaAdi As String

Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, [A:A]) Is Nothing Then Exit Sub
    If Hucre Is Nothing Then Exit Sub
    If Target.Text = "" And Target.Address = Hucre.Address Then
        Application.DisplayAlerts = False
        Sheets(SayfaAdi).Delete
        Application.DisplayAlerts = True
    End If
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Intersect(Target, [A:A]) Is Nothing Then Exit Sub
    If Target.Text = "" Then
        Set Hucre = Nothing
    Else
        Set Hucre = Target
        SayfaAdi = Target.Text
    End If
End Sub
 
İcmal sayfasının kodlarını silip aşağıdakileri kopyalayın.

Kod: 
Dim Hucre As Range
Dim SayfaAdi As String

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    On Error Resume Next
    If Intersect(Target, [A:A]) Is Nothing Then Exit Sub
    If Target.Text = "" Then
        Set Hucre = Nothing
    Else
        Set Hucre = Target
        SayfaAdi = Target.Text
    End If
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, [A:A]) Is Nothing Then Exit Sub
    If Hucre Is Nothing Then Exit Sub
    If Target.Text = "" And Target.Address = Hucre.Address Then
        Application.DisplayAlerts = False
        Sheets(SayfaAdi).Delete
        Application.DisplayAlerts = True
    End If
On Error GoTo bitti
Dim Sayfa As String
If ActiveSheet.Name <> "İCMAL" Then
    Sheets("İCMAL").Select
Else
    Sayfa = Target.Value
    If Not SayfaVarMi(Sayfa) Then
    If Sayfa <> "" Then Sheets(Sayfa).Select
    End If
End If
Exit Sub
bitti:
If Intersect(Target, Sheets("İCMAL").[A3:A500]) Is Nothing Then Exit Sub
If Not SayfaVarMi(Sayfa) Then
    Sheets("Şablon").Copy After:=Sheets(Sheets.Count)
    ActiveSheet.Name = Target.Value
    
    Sheets("İCMAL").Select
  For i = 3 To Sheets("İCMAL").Range("a65536").End(xlUp).Row
    ActiveSheet.Hyperlinks.Add Anchor:=Range("a" & i), Address:="", SubAddress:= _
"'" & Sheets("İCMAL").Range("a" & i).Value & "'!a1"
Next i
    
    End If
End Sub

Function SayfaVarMi(SayfaAdi As String) As Boolean
On Error Resume Next
SayfaVarMi = CBool(Len(Worksheets(SayfaAdi).Name) > 0)
End Function
 
dalgalikur' Alıntı:
İcmal sayfasının kodlarını silip aşağıdakileri kopyalayın.

Kod: 
Dim Hucre As Range
Dim SayfaAdi As String

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    On Error Resume Next
    If Intersect(Target, [A:A]) Is Nothing Then Exit Sub
    If Target.Text = "" Then
        Set Hucre = Nothing
    Else
        Set Hucre = Target
        SayfaAdi = Target.Text
    End If
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, [A:A]) Is Nothing Then Exit Sub
    If Hucre Is Nothing Then Exit Sub
    If Target.Text = "" And Target.Address = Hucre.Address Then
        Application.DisplayAlerts = False
        [COLOR="black"][COLOR="black"][COLOR="Yellow"]Sheets(SayfaAdi).Delete[/COLOR][/COLOR][/COLOR]
        Application.DisplayAlerts = True
    End If
On Error GoTo bitti
Dim Sayfa As String
If ActiveSheet.Name <> "İCMAL" Then
    Sheets("İCMAL").Select
Else
    Sayfa = Target.Value
    If Not SayfaVarMi(Sayfa) Then
    If Sayfa <> "" Then Sheets(Sayfa).Select
    End If
End If
Exit Sub
bitti:
If Intersect(Target, Sheets("İCMAL").[A3:A500]) Is Nothing Then Exit Sub
If Not SayfaVarMi(Sayfa) Then
    Sheets("Şablon").Copy After:=Sheets(Sheets.Count)
    ActiveSheet.Name = Target.Value
    
    Sheets("İCMAL").Select
  For i = 3 To Sheets("İCMAL").Range("a65536").End(xlUp).Row
    ActiveSheet.Hyperlinks.Add Anchor:=Range("a" & i), Address:="", SubAddress:= _
"'" & Sheets("İCMAL").Range("a" & i).Value & "'!a1"
Next i
    
    End If
End Sub

Function SayfaVarMi(SayfaAdi As String) As Boolean
On Error Resume Next
SayfaVarMi = CBool(Len(Worksheets(SayfaAdi).Name) > 0)
End Function
Genişletmek için tıkla ...

Hocam gönderdiğiniz kod sarı ile işaretli yer hata veriyor
 
Silmek istediğiniz sayfa zaten olmadığı için hata alıyorsunuz.

İcmal sayfasındaki kodları silip aşağıdaki kodları kopyalayın.

Kod: 
Dim Hucre As Range
Dim SayfaAdi As String

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    On Error Resume Next
    If Intersect(Target, [A:A]) Is Nothing Then Exit Sub
    If Target.Text = "" Then
        Set Hucre = Nothing
    Else
        Set Hucre = Target
        SayfaAdi = Target.Text
    End If
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, [A:A]) Is Nothing Then Exit Sub
    If Hucre Is Nothing Then Exit Sub
    If Target.Text = "" And Target.Address = Hucre.Address Then
        Application.DisplayAlerts = False
        Dim syf As Worksheet
        Dim SayfaVar As Boolean
        For Each syf In ThisWorkbook.Worksheets
            SayfaVar = False
            If syf.Name = SayfaAdi Then
                SayfaVar = True
                Exit For
            End If
        Next
        If SayfaVar = False Then
            MsgBox "'" & SayfaAdi & "' adlı sayfa zaten yok."
            Exit Sub
        End If
        Sheets(SayfaAdi).Delete
        Application.DisplayAlerts = True
    End If
On Error GoTo bitti
Dim Sayfa As String
If ActiveSheet.Name <> "İCMAL" Then
    Sheets("İCMAL").Select
Else
    Sayfa = Target.Value
    If Not SayfaVarMi(Sayfa) Then
    If Sayfa <> "" Then Sheets(Sayfa).Select
    End If
End If
Exit Sub
bitti:
If Intersect(Target, Sheets("İCMAL").[A3:A500]) Is Nothing Then Exit Sub
If Not SayfaVarMi(Sayfa) Then
    Sheets("Şablon").Copy After:=Sheets(Sheets.Count)
    ActiveSheet.Name = Target.Value
    
    Sheets("İCMAL").Select
  For i = 3 To Sheets("İCMAL").Range("a65536").End(xlUp).Row
    ActiveSheet.Hyperlinks.Add Anchor:=Range("a" & i), Address:="", SubAddress:= _
"'" & Sheets("İCMAL").Range("a" & i).Value & "'!a1"
Next i
    
    End If
End Sub

Function SayfaVarMi(SayfaAdi As String) As Boolean
On Error Resume Next
SayfaVarMi = CBool(Len(Worksheets(SayfaAdi).Name) > 0)
End Function
 
Yok hocam ben beceremedim bu sefer de mesaj çıkıyor sayfa zaten yok diyor ama sayfayı silmiyor
 
Sayfa zaten yoksa nasıl silecek?
 
Hocam sizi de yoruyorum ama ben a sütunundan bir ismi sildigimde bu ismin sayfası var olmasına rağmen sadece mesaj çıkıyor sayfa silinmiyor
 
siliyorum derken satırı komple mi siliyorsunuz?
Yoksa sadece hücre içeriğini mi siliyorsunuz?
 
O halde çalışması lazım.
Ben birçok kez denedim, hücre içeriğini silince aynı adlı sayfa da siliniyor.

Ekte deneme yaptığım örnek dosya mevcut.
 

Ekli dosyalar

Hocam elinize sağlık tam istediğim gibi hakkınızı helal edin sizi bayağı uğraştırdım.
 
Helal olsun. İyi akşamlar.
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst