• DİKKAT

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

Makro sayfa çoğaltmıyor??

O

ockucukay

Katılım
29 Aralık 2005
Mesajlar
862
Excel Vers. ve Dili
Office 365 Türkçe
Merhaba

Ben aşağıdaki kod yardımıyla şablon bir sayfadan rapor yapıyorum. Ancak makro 61 sayfa olduğunda daha fazla kopyalama yapmıyor. Benim bildiğim kadarıyla 256 sayfaya kadar yapması lazım, neden yapmadığı hakkında fikri olan var mı? Yardımcı olursanız sevinirim.

İlgili dosya ektedir. Kod:

Sub Sayfa_Ekle()

Dim blnfound As Boolean
Dim i As Integer
Dim ws As Object
Dim strListSheet As String: strListSheet = "Sevk Listesi" 'The name of the sheet that has the list.

For i = 2 To Sheets(strListSheet).Cells(Rows.Count, 1).End(xlUp).Row
blnfound = False
For Each ws In ThisWorkbook.Worksheets
If UCase(ws.Name) = UCase(CStr(Sheets(strListSheet).Cells(i, 1).Value)) Then blnfound = True
Next ws
If blnfound = False Then
Sheets("Sablon").Copy After:=Sheets(Worksheets.Count)
ActiveSheet.Name = Sheets(strListSheet).Cells(i, 1).Value
End If
Next i

End Sub
 

Ekli dosyalar

Merhaba,

2010 sürümü ile denedim bir sorun çıkmadı.
 
ben 2003 office ile deniyorum. Toplam 60 sayfa olduğunda makro "Sheets("Sablon").Copy After:=Sheets(Worksheets.Count)" bu kod üstünde hata veriyor. Manuel olarak dahi sayfa kopyalayamıyorum.
 
2003 sürümde 46 da kaldım ben :)
 
sorun ne olabilir acaba? bir fikriniz var mı necdet bey?
 
tüh, arkadaşlar çözümün ne olabileceği hakkında bir fikri olan var mı?
 
Merhaba

On Error Resume Next ilavesi sorunu çözer.
ya da kopyalanacak sayfa sayısınına x dersek; y=0 koypalanan sayfadan sonra y=y+1 ve eğer if y=59 then thisworkbook save ile dosyayı kaydedin.
excel 2003 de çok fazla sayfa ekleme işlemi yapıldığında (bu örnekte 60 ama bazen farklı olabiliyor, nedendir bilmem) daha fazla sayfa eklemek için dosyayı kaydetmeniz gerekir.
bunu el ile sayfa ekleyerek de gözlemleyebilirsiniz.
 
Kodu aşağıdaki hale getirmeme rağmen ana sayfa ve şablon sayfası dahil 61 sayfayı geçemedim. Bilgisayarım İ5 işlemci ve 4 GB RAM var. Söylediğiniz kodları nereye yazmam lazım?

Sub Sayfa_Ekle()

Dim blnfound As Boolean
Dim i As Integer
Dim ws As Object
Dim strListSheet As String: strListSheet = "Sevk Listesi" 'The name of the sheet that has the list.

For i = 2 To Sheets(strListSheet).Cells(Rows.Count, 1).End(xlUp).Row
blnfound = False
For Each ws In ThisWorkbook.Worksheets
If UCase(ws.Name) = UCase(CStr(Sheets(strListSheet).Cells(i, 1).Value)) Then blnfound = True
Next ws
If blnfound = False Then
Sheets("Sablon").Copy After:=Sheets(Worksheets.Count)
ActiveSheet.Name = Sheets(strListSheet).Cells(i, 1).Value
ThisWorkbook.Save
End If
Next i

End Sub

uzmanamele' Alıntı:
Merhaba

On Error Resume Next ilavesi sorunu çözer.
ya da kopyalanacak sayfa sayısınına x dersek; y=0 koypalanan sayfadan sonra y=y+1 ve eğer if y=59 then thisworkbook save ile dosyayı kaydedin.
excel 2003 de çok fazla sayfa ekleme işlemi yapıldığında (bu örnekte 60 ama bazen farklı olabiliyor, nedendir bilmem) daha fazla sayfa eklemek için dosyayı kaydetmeniz gerekir.
bunu el ile sayfa ekleyerek de gözlemleyebilirsiniz.
Genişletmek için tıkla ...
 
Son düzenleme:
Merhaba,

#9 nolu mesajımda verdiğim linkte gerekli açıklamalar yapılmış.

Bence sisteminizi denemek için boş bir excel sayfasını aşağıdaki kod ile kopyalamayı deneyin. Eğer sorun çıkarmadan belirttiğiniz adet sayfadan fazla ekleniyorsa bu durumda sizin dosyanızdaki ŞABLON sayfanızın yüklü olmasından dolayı istediğiniz sayıda ekleme yapamıyorsunuz demektir.

Kod: 
Sub SAYFA_KOPYALA()
    İLK = Time
    SAY = InputBox("Kopyalanacak sayfa sayısını giriniz...")
 
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
 
    For X = 1 To SAY
        Sheets("Sayfa1").Copy After:=Sheets(Worksheets.Count)
        ActiveSheet.Name = X
        ActiveSheet.Range("A5").Value = X
    Next
 
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
 
    MsgBox "İşleminiz tamamlanmıştır." & Chr(10) & _
    "İşlem süresi ; " & Format(Time - İLK, "hh:mm:ss")
End Sub

Ben işyerimdeki bilgisayarımda denedim. Boş excel sayfasından 1500 adet sayfayı yaklaşık 11 dakikada kopyaladı.
Aynı kod ile 250 adet sayfa eklemeyi denediğimde yaklaşık 17 saniyede işlemi tamamladı. 1500 sayfadaki performansla kıyasladığımızda bu sürenin 110 saniye olması gerekiyordu. Sayfa sayısı arttıkça bellek fazla kullanıldığı için bir süre sonra sistem yeterli performansı gösteremiyor. Hele ŞABLON sayfada veri varsa gerisini siz düşünün.

Sistem özellikleri;
Office 2003 Türkçe
PENTIUM-D 3,20 GHZ işlemci
2 GB RAM

Sizin işlemciniz daha yeni bir işlemci olduğu için daha rahat bir performans sergilemesi gerekiyor.
 
Merhaba Korhan hocam

Öncelikle cevabınız için teşekkür ederim. Ben verdiğiniz linki incelemiştim. Ama farklı denemeler yapmama rağmen 60 sayısını geçememiştim. Verdiğiniz koda gelince; aynı kodu bende 100 sayfa ile denedim, 16 saniyede tamamlandı. Yani boş sayfa kopyalamada sorun yok. Ama benim ihtiyacım olan sablon sayfasından kopyalama yapmak.

Dediğinizi uygulayıp sayfa üzerinde olan basit formülleri (düşeyara vb) kaldırdım ve sadece boş tablo sayfasını kopyaladım. 14 saniyede tamamlandı. Anladığım kadarıyla sorun şablon sayfasının dolu olması değil, sayfa isimlerini düzenlemek için her seferinde sevk listesi sayfasından sayfa numaralarını almasından kaynaklanıyor. Bu sorunu gidermede bana yardımcı olursanız sevinirim.

Korhan Ayhan' Alıntı:
Merhaba,

#9 nolu mesajımda verdiğim linkte gerekli açıklamalar yapılmış.

Bence sisteminizi denemek için boş bir excel sayfasını aşağıdaki kod ile kopyalamayı deneyin. Eğer sorun çıkarmadan belirttiğiniz adet sayfadan fazla ekleniyorsa bu durumda sizin dosyanızdaki ŞABLON sayfanızın yüklü olmasından dolayı istediğiniz sayıda ekleme yapamıyorsunuz demektir.

Kod: 
Sub SAYFA_KOPYALA()
    İLK = Time
    SAY = InputBox("Kopyalanacak sayfa sayısını giriniz...")
 
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
 
    For X = 1 To SAY
        Sheets("Sayfa1").Copy After:=Sheets(Worksheets.Count)
        ActiveSheet.Name = X
        ActiveSheet.Range("A5").Value = X
    Next
 
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
 
    MsgBox "İşleminiz tamamlanmıştır." & Chr(10) & _
    "İşlem süresi ; " & Format(Time - İLK, "hh:mm:ss")
End Sub
Ben işyerimdeki bilgisayarımda denedim. Boş excel sayfasından 1500 adet sayfayı yaklaşık 11 dakikada kopyaladı.
Aynı kod ile 250 adet sayfa eklemeyi denediğimde yaklaşık 17 saniyede işlemi tamamladı. 1500 sayfadaki performansla kıyasladığımızda bu sürenin 110 saniye olması gerekiyordu. Sayfa sayısı arttıkça bellek fazla kullanıldığı için bir süre sonra sistem yeterli performansı gösteremiyor. Hele ŞABLON sayfada veri varsa gerisini siz düşünün.

Sistem özellikleri;
Office 2003 Türkçe
PENTIUM-D 3,20 GHZ işlemci
2 GB RAM

Sizin işlemciniz daha yeni bir işlemci olduğu için daha rahat bir performans sergilemesi gerekiyor.
Genişletmek için tıkla ...
 
Merhaba,

Örnek dosyanızı ekleyip ne yapmak istediğinizi açıklarmısınız.
 
Merhaba Korhan Hocam

Ekte gördiünüz dosya bir rapor hazırlama dosyası. Günlük olarak sevkiyat yapan arkadaşlar tarafından kullanılıyor. Amacımız, sevk listesi sayfasında sevk edilecek her kutu için bir numara veriliyor. Daha sonra Sablon sayfasından kopyalanan rapor formatının numarası sevk listesindeki numaralara uygun olarak değiştiriliyor. Örneğin Sevk listesinde rapor numaraları 1,2,3 olsun. Sablon sayfasından kopyalanan sayfaların numaraları da 1,2,3 olarak değiştiriliyor. Bu şekilde kutuların raporlarını geriye doğru takip edebiliyoruz. Umarım ne yapmak istediğimi anlatabilmişimdir. İlginize tekrar teşekkür ederim.
 

Ekli dosyalar

Arkadaşlar, yardımcı olabilecek birisi var mı acaba?
 
Merhaba,

Bende alternatif olarak sayfa kopyalama yerine yeni sayfa ekleyip şablon sayfasının içeriğini yeni eklenen sayfaya kopyalayarak çözüm ürettim. Buradaki tek sıkıntı şablon sayfasının önizlemedeki ayarlarının yeni eklenen sayfaya uyarlanmamasıdır. Bunuda koda ekleyerek sorunu çözdüm. Fakat bu işlem kodun çalışma süresini uzatmaktadır. Bu sebeple kodun en sonuna bu işlemi yapacak bir sorgu ekledim.

Kod kısaca aşağıdaki işlemleri yapıyor.

Yeni sayfalar eklenecek. (3-5 saniye sürüyor)
Ekleme işlemi bitince size "Sayfa ayarlarını yapmak istiyor musunuz?" şeklinde bir uyarı mesajı verecek.
Bu mesaja vereceğiniz cevaba göre işlemi tamamlayacak.
Sayfa yapılarını ayarlamak benim sistemimde yaklaşık 2 dakika sürdü. Sizde süre kısalabilir. Tabi sürenin uzun ya da kısa olması sayfa sayısı ile de alakalıdır.

Ayırca eklenen sayfaları silebilmeniz içinde dosyanıza bir kod ekledim. Sayfa silme işlemi onaya bağlıdır. (Şifresi +++)

Not: Dosyanızdaki eski kodların tamamını sildim.

Uygulanan kod; (Boş modüle uygulayınız)

Kod: 
Dim S1 As Worksheet, S2 As Worksheet, Sayfa As Worksheet, X As Integer, Say As Integer
 
Sub Sayfa_Ekle()
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    
    Set S1 = Sheets("Sablon")
    Set S2 = Sheets("Sevk Listesi")
    
    For X = 2 To S2.Cells(Rows.Count, 1).End(3).Row
        If S2.Cells(X, 1) <> "" Then
            On Error Resume Next
            Set Sayfa = Sheets(S2.Cells(X, 1).Text)
            On Error GoTo 0
            If Sayfa Is Nothing Then
                Sheets.Add , Sheets(Worksheets.Count)
                ActiveSheet.Name = S2.Cells(X, 1)
                S1.Cells.Copy Range("A1")
                Say = Say + 1
                ActiveWindow.Zoom = 75
                ActiveWindow.DisplayGridlines = False
            End If
            Set Sayfa = Nothing
        End If
    Next
    
    S2.Select
    
    If Say > 0 Then
        If MsgBox("Eklenen yeni sayfaların sayfa yapıları ayarlanacaktır!" & Chr(10) & _
        "İşlem uzun sürebilir." & Chr(10) & _
        "İşlemi onaylıyor musunuz?", vbExclamation + vbYesNo, "Dikkat !") = vbNo Then
            Set S1 = Nothing
            Set S2 = Nothing
            Application.Calculation = xlCalculationAutomatic
            Application.ScreenUpdating = True
            MsgBox "İşleminiz tamamlanmıştır.", vbInformation
        Else
            Sayfa_Yapısı_Ayarla
        End If
    End If
End Sub
 
Sub Sayfa_Yapısı_Ayarla()
    Application.ScreenUpdating = False
    For X = 3 To Worksheets.Count
        With Sheets(X).PageSetup
            .PrintArea = "$A$1:$E$54"
            .LeftHeader = ""
            .CenterHeader = ""
            .RightHeader = ""
            .LeftFooter = ""
            .CenterFooter = ""
            .RightFooter = ""
            .LeftMargin = Application.InchesToPoints(0.748031496062992)
            .RightMargin = Application.InchesToPoints(0.31496062992126)
            .TopMargin = Application.InchesToPoints(0.15748031496063)
            .BottomMargin = Application.InchesToPoints(0.511811023622047)
            .HeaderMargin = Application.InchesToPoints(0.118110236220472)
            .FooterMargin = Application.InchesToPoints(0.433070866141732)
            .PrintHeadings = False
            .PrintGridlines = False
            .PrintComments = xlPrintNoComments
            .CenterHorizontally = False
            .CenterVertically = False
            .Orientation = xlPortrait
            .Draft = False
            .PaperSize = xlPaperA4
            .FirstPageNumber = xlAutomatic
            .Order = xlDownThenOver
            .BlackAndWhite = False
            .Zoom = 115
            .PrintErrors = xlPrintErrorsDisplayed
        End With
    Next
 
    Set S1 = Nothing
    Set S2 = Nothing
    
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
    
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub
 
Sub Sayfaları_Sil()
    Dim Onay, X As Integer
    
    Onay = Application.InputBox("Sayfaları silmek için yetkili şifresini giriniz !", "Sayfa silme işlemi")
    If Onay = False Or Onay = "" Then
        MsgBox "İşleminiz iptal edilmiştir.", vbInformation
        Exit Sub
    End If
    
    If Onay = "+++" Then
        Application.DisplayAlerts = False
            For X = Worksheets.Count To 3 Step -1
                Sheets(X).Delete
            Next
        Application.DisplayAlerts = True
        MsgBox "Silme işlemi tamamlanmıştır.", vbInformation
    Else
        MsgBox "Hatalı şifre girdiniz !" & Chr(10) & _
        "Lütfen daha sonra tekrar deneyiniz.", vbCritical
    End If
End Sub
 

Ekli dosyalar

Sayın uzmanamele

öncelikle ilginize çok teşekkürler. yaptığınız dosyayı denedim. 60.sayfadan sonra son sayfanın adı sürekli değişiyor, ta ki sevk listesindeki son sayı gelene kadar, neden böyle olduğunu anlamadım. Ama bu sınıra gelene kadar düzgün çalışıyor.

Sayın Korhan Ayhan

Emeklerinize çok teşekkür ederim. Dosyanız gayet güzel çalışıyor. Hız dert değil, makroları da koydum, ona rağmen hızında bir değişme yok.Tekrar ilginiz için teşekkür ederim.
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst