Sayfa Ekleme Hatası

T

Tasarım

Katılım
3 Şubat 2005
Mesajlar
216
Excel Vers. ve Dili
Microsoft Excel 2024 Türkçe
Kod: 
Sub sayfaekle()
Sheets("Cizelge").Select
Range("A3:AN114").Select
Selection.Copy
Range("A2").Select
Sheets.Add , After:=Sheets(Sheets.Count)
ActiveSheet.Name = [ay].Value
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Range("B106:AE106").Select: Selection.Merge
Columns("B:AM").EntireColumn.AutoFit
Columns("AK:AN").Select
Selection.ColumnWidth = 3.5
Columns("A").Select
Selection.ColumnWidth = 4
Sheets("Cizelge").Select
End Sub
Arkadaşlar yukarıda kodlarla güncel ay ismi ile yeni sayfa ekliyorum. Verileri aldığım sayfada değişiklik yapıp tekrar kodları çalıştırdığımda farklı bir sayfa ekleyip hata veriyor.
Benim isteğim ay değişmemişse daha önce eklenen Örnek: "Temmuz 2014" isimli sayfaya yeni verileri yapıştırsın.
Bu konuda yardımlarınızı bekliyorum.
 
Emir Hüseyin Çoban

Emir Hüseyin Çoban

Destek Ekibi
Destek Ekibi
Katılım
11 Ağustos 2008
Mesajlar
5,892
Excel Vers. ve Dili
Office 2013 Tr - Win10 x64
. . .

Kod: 
Sub sayfaekle()
    Application.ScreenUpdating = False
    Dim Sayfa As String
    
    Sheets("Cizelge").Select
    Range("A3:AN114").Select
    Selection.Copy
    Range("A2").Select
    
    Sayfa = [AY].Value
    If Not SayfaVarMi(Sayfa) Then
        Sheets.Add , After:=Sheets(Sheets.Count)
        ActiveSheet.Name = [AY].Value
    Else
    End If
    
    Sheets(Sayfa).Select
    Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    Range("B106:AE106").Select: Selection.Merge
    Columns("B:AM").EntireColumn.AutoFit
    Columns("AK:AN").Select
    Selection.ColumnWidth = 3.5
    Columns("A").Select
    Selection.ColumnWidth = 4
    Sheets("Cizelge").Select
    Application.ScreenUpdating = True
End Sub

Function SayfaVarMi(Sayfa As String) As Boolean
    On Error Resume Next
    SayfaVarMi = CBool(Len(Worksheets(Sayfa).Name) > 0)
End Function
. . .
 
T

Tasarım

Katılım
3 Şubat 2005
Mesajlar
216
Excel Vers. ve Dili
Microsoft Excel 2024 Türkçe
Hüseyin hocam selamlar.
Sizin kodun üzerinde biraz oynamayla işimi hallettim. Belki başka arkadaşlara da gerekli olabilir diye burada paylaşıyorum.
Kodun özelliği:
- Güncel ay değerine göre yeni sayfa ekleyip, verileri üzerine yazabiliyor.
- Eğer aynı isimle sayfa varsa eskisini silip yenisi oluşturuyor.

Kod: 
Sub Sayfa_Ekle()
    Application.ScreenUpdating = False
    Dim Sayfa As String
    On Error Resume Next
    Sheets("Cizelge").Select
    Range("A3:AN114").Select
    Selection.Copy
    Range("A2").Select
    Sayfa = [ay].Value
    Application.DisplayAlerts = False
    Sheets(Sayfa).Delete
    If Not SayfaVarMi(Sayfa) Then
    Sheets.Add , After:=Sheets(Sheets.Count)
    ActiveSheet.Name = [ay].Value
    Else
    End If
    Sheets("Cizelge").Select
    Range("A3:AN114").Select
    Selection.Copy
    Range("A2").Select
    Sheets(Sayfa).Select
    Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    Range("B106:AE106").Select: Selection.Merge
    Columns("B:AM").EntireColumn.AutoFit
    Columns("AK:AN").Select
    Selection.ColumnWidth = 3.5
    Columns("A").Select
    Selection.ColumnWidth = 4
    Sheets("Cizelge").Select
    Application.ScreenUpdating = True
End Sub
Function SayfaVarMi(Sayfa As String) As Boolean
    On Error Resume Next
    SayfaVarMi = CBool(Len(Worksheets(Sayfa).Name) > 0)
End Function
 
Emir Hüseyin Çoban

Emir Hüseyin Çoban

Destek Ekibi
Destek Ekibi
Katılım
11 Ağustos 2008
Mesajlar
5,892
Excel Vers. ve Dili
Office 2013 Tr - Win10 x64
. . .

Sayfa var ise ve silinecekse. Sayfa var mı diye baktırmaya gerek yok.
On error resume next kullanmışsınız. Silme kısmında sayfa yoksa bile işleme devam edecektir.

Kodları döngüye sokup, koşul aratmaya gerek yok.

. . .
 
T

Tasarım

Katılım
3 Şubat 2005
Mesajlar
216
Excel Vers. ve Dili
Microsoft Excel 2024 Türkçe
Hüseyin Çoban' Alıntı:
. . .

Sayfa var ise ve silinecekse. Sayfa var mı diye baktırmaya gerek yok.
On error resume next kullanmışsınız. Silme kısmında sayfa yoksa bile işleme devam edecektir.

Kodları döngüye sokup, koşul aratmaya gerek yok.

. . .
Genişletmek için tıkla ...
- Hocam başka türlü içinden çıkamadım.
- Ancak böyle oldu :)
 
Korhan Ayhan

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
42,307
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
Merhaba,

Kodunuzu aşağıdaki gibi düzenlerseniz daha okunaklı ve düzenli olacaktır.

Kod: 
Sub Sayfa_Ekle()
    Dim Sayfa As String
    
    On Error Resume Next
    
    Application.ScreenUpdating = False
    
    Sayfa = [ay].Value
    
    Application.DisplayAlerts = False
    Sheets(Sayfa).Delete
    Application.DisplayAlerts = True
    
    Sheets.Add , After:=Sheets(Sheets.Count)
    ActiveSheet.Name = [ay].Value
    
    Sheets("Cizelge").Range("A3:AN114").Copy
    
    With Sheets(Sayfa)
        .Select
        .Range("A1").PasteSpecial Paste:=xlPasteValues
        .Range("A1").PasteSpecial Paste:=xlPasteFormats
        .Range("B106:AE106").Merge
        .Columns("B:AM").EntireColumn.AutoFit
        .Columns("AK:AN").ColumnWidth = 3.5
        .Columns("A").ColumnWidth = 4
        .Range("A1").Select
    End With
    
    Sheets("Cizelge").Select
    
    Application.ScreenUpdating = True
End Sub
 
halit3

halit3

Uzman
Uzman
Katılım
18 Ocak 2008
Mesajlar
12,800
Excel Vers. ve Dili
2003 excell türkçe
ve
2007 excell türkçe
Tasarım' Alıntı:
Kod: 
Sub sayfaekle()
Sheets("Cizelge").Select
Range("A3:AN114").Select
Selection.Copy
Range("A2").Select
Sheets.Add , After:=Sheets(Sheets.Count)
ActiveSheet.Name = [ay].Value
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Range("B106:AE106").Select: Selection.Merge
Columns("B:AM").EntireColumn.AutoFit
Columns("AK:AN").Select
Selection.ColumnWidth = 3.5
Columns("A").Select
Selection.ColumnWidth = 4
Sheets("Cizelge").Select
End Sub
Arkadaşlar yukarıda kodlarla güncel ay ismi ile yeni sayfa ekliyorum. Verileri aldığım sayfada değişiklik yapıp tekrar kodları çalıştırdığımda farklı bir sayfa ekleyip hata veriyor.
Benim isteğim ay değişmemişse daha önce eklenen Örnek: "Temmuz 2014" isimli sayfaya yeni verileri yapıştırsın.
Bu konuda yardımlarınızı bekliyorum.
Genişletmek için tıkla ...
Merhaba ben burada sayfa ile ilgili değişkeni anlıyamadım.

Sayfa = [AY].Value

ActiveSheet.Name = [AY].Value

yukarıdaki kırmızı olan değerler ne anlama geliyor.
 
Korhan Ayhan

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
42,307
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
Halit Bey,

Hücreye ad tanımlaması yapılmış ve kod içinde kullanılmış.
 
T

Tasarım

Katılım
3 Şubat 2005
Mesajlar
216
Excel Vers. ve Dili
Microsoft Excel 2024 Türkçe
Korhan Ayhan' Alıntı:
Merhaba,

Kodunuzu aşağıdaki gibi düzenlerseniz daha okunaklı ve düzenli olacaktır.

Kod: 
Sub Sayfa_Ekle()
    Dim Sayfa As String
    
    On Error Resume Next
    
    Application.ScreenUpdating = False
    
    Sayfa = [ay].Value
    
    Application.DisplayAlerts = False
    Sheets(Sayfa).Delete
    Application.DisplayAlerts = True
    
    Sheets.Add , After:=Sheets(Sheets.Count)
    ActiveSheet.Name = [ay].Value
    
    Sheets("Cizelge").Range("A3:AN114").Copy
    
    With Sheets(Sayfa)
        .Select
        .Range("A1").PasteSpecial Paste:=xlPasteValues
        .Range("A1").PasteSpecial Paste:=xlPasteFormats
        .Range("B106:AE106").Merge
        .Columns("B:AM").EntireColumn.AutoFit
        .Columns("AK:AN").ColumnWidth = 3.5
        .Columns("A").ColumnWidth = 4
        .Range("A1").Select
    End With
    
    Sheets("Cizelge").Select
    
    Application.ScreenUpdating = True
End Sub
Genişletmek için tıkla ...
Korhan hocam bu kod da gayet güzel çalışıyor.
Elinize sağlık.
 
Korhan Ayhan

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
42,307
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
Kodlarınızda gereksiz yere "Select" ifadesi kullanmayın. Kodlarınızın yavaş çalışmasına sebep olur. Ayrıca gereksiz yere kod kalabalıklığı yaratır.
 
Cevap yazmak için giriş yap yada kayıt ol.
Üst