• DİKKAT

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

Sayfa Ekleme Hatası

Tasarım

Tasarım

Katılım
3 Şubat 2005
Mesajlar
294
Excel Vers. ve Dili
Microsoft Excel 2013 32Bit 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.
 
. . .

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

. . .
 
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
 
. . .

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.

. . .
 
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 :)
 
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
 
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.
 
Halit Bey,

Hücreye ad tanımlaması yapılmış ve kod içinde kullanılmış.
 
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.
 
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.
 
Korhan Ayhan' Alıntı:
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.
Genişletmek için tıkla ...

Sağolun hocam Allah razı olsun. :)
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst