Makro ile çalışmasını sayfasının kopyasını alma

[leylaz]

Merhaba arkadaşlar ekteki dosyamda iki tane çalışma sayfası mevcut.
Çoğalt adlı sayfada bir buton var.Bu butona basınca liste adlı çalışma sayfasını macro ile kopyasını oluşturuyorum. Şöyle bir sıkıntım mevcut.

Liste sayfamda da iki buton mevcut bunlarda da macro var. Kopyalama esnasında bu liste sayfasındaki buton isimleri değişiyor. Çoğaltma sayıma göre buton isimleri düğme 5-6 .. diye gidiyor. Bunun nedeni nedir? Nasıl önlerim?

Ek bir soru: Makro ile çoğaltma esnasında yeni olaşan sayfalara listeden sıra ile isim vermek mümkün mü?

 

[Levent Menteşoğlu]

Dosyanızdaki kodu aşağıdaki ile değiştirin. "sayfa adı" yerine listeden alınacak adı içeren bir kod ekleyebilirsiniz.

Sub ccc()
Sheets("liste").Copy After:=Sheets(Sheets.Count)
Sheets(Sheets.Count).Name = "sayfa adı"
End Sub

 

[leylaz]

Levent Bey teşekkür ederim kod işimi gördü. İzninizle bir soru daha sormak istiyorum. Kodlamada "sayfa adı" yerine belirlediğim bir hücredeki ismi yazdırmam mümkün mü?
Yani coğalt butonuma bastığımda oluşturduğu sayfayanın adına B2 hücresindeki ismi yazacak.

 

[Emir Hüseyin Çoban]

. . .

Sheets(Sheets.Count).Name = "sayfa adı"

yerine

Sheets(Sheets.Count).Name =range("B2")

. . .

 

[leylaz]

Hüseyin Bey range değerini liste çalışma sayfasından alıyor. Ben range değeri cogalt sayfamdaki b2 den çekmesini istiyorum.

 

[Korhan Ayhan]

Merhaba,

Aşağıdaki gibi deneyiniz.

Sheets(Sheets.Count).Name = Sheets("cogalt").Range("B2")

 

[leylaz]

Arkdaşlar ilginiz için teşekkür ederim. Allah razı olsun.

 

[leylaz]

İzninizle 4 yıl üstüne bir soru daha sormak istiyorum.

Aşağıdaki kod ile liste adlı sayfamı çoğaltıyorum. Bu işlemi her hücre için tekrarlamak yerine bir kerede Genel adlı sayfamın C sütunundaki (dolu hücrelerdeki) isimleri alarak çoğaltabilir miyiz?

Sub cogalt()
Sheets("liste").Copy After:=Sheets(Sheets.Count)
Sheets(Sheets.Count).Name = Sheets("Genel").Range("C6")

 

[Emir Hüseyin Çoban]

Biraz daha ayrinti vermelisiniz.
Kacinci satirdan baslayacak.
Ayni isimden daha once acilan sayfa olabilir mi.

.

 

[leylaz]

Biraz daha ayrinti vermelisiniz.
Kacinci satirdan baslayacak.
Ayni isimden daha once acilan sayfa olabilir mi.

.

Örnek dosya ekledim. Genel adlı sayfamda isimler var. Bu isimleri F6 yazıp coğalt makrosu ile bos_ sayfamı çoğaltıyorum.
Tek tek uğraşmak yerine C: sütünuna yazdığım isimleri çoğaltmasını istiyorum.

*Aynı isimden sayfa olmayacak.
*Başlayacağı satır değişken olabilir.
*İsimleri başka bir sayfadan çekeceğim için C:deki yada C8:C100 gibi aralıktaki isimleri çoğaltmak istiyorum.

http://s4.dosya.tc/server3/17p5uw/deneme.zip.html

 

[vardar07]

Sizdeki kodları aşağıdakiler ile değiştirip denermisiniz.

Sub cogalt()
Dim syf As String
Dim bak As Range
With Sheets("Genel")
    For Each bak In .Range("C4:C" & .Range("C65536").End(3).Row)
  sayfa = .Cells(bak.Row, "C")
        If .Cells(bak.Row, "C") <> "" Then
 syf = sayfa
               If Not varmi(syf) Then
                   Sheets.Add After:=Worksheets(Worksheets.Count)
                   ActiveSheet.Name = syf
[COLOR="Red"][B] Sheets("bos_").Cells.Copy Sheets(syf).Range("A1")
 [/B][/COLOR]End If
End If
Next bak
End With
    MsgBox "İŞLEM TAMAMDIR"
End Sub

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

 

[leylaz]

@vardar07 kodlaş tıkır tıkır işliyor.
Aynı isimden sayfa olacak mı diye sormuştunuz hayır cevabını vermiştim. Şimdi düşündüm de aynı isim varsa onları çoğaltmayıp yeni eklenen isimleri çoğaltabilir mi?

Çünkü; çoğalt butonuma iki kere bastığımda var olan kaydın üzerine tekrar yazıyor. Oluşturduğum sayfalar içindeki güncellemelerde buharlaşıyor dolayısıyla.

Neden iki kere butona tıklıyorsun gibi bir algı olabilir. Yeni isimler ekliyorum onları da bu butonla çoğaltmak istiyorum.

Hatamı sonradan görünce ek bir soru oldu

 

[vardar07]

Yukarı mesajdaki kırmızılı yeri sizdeki ile aynı yapıp deneyin.

 

[leylaz]

Kopyalama işi sorunsuz fakat kopyalarken hücre biçimlerine dikkat etmiyor. Bos_ sayfayısını bire bir klonlayamayız mı?

 

[vardar07]

#11 nolu mesajdaki kodu kontrol edip deneyiniz.
Ayrıca var olan sayfaları güncellemeden yenilerini kopyalar.

 

[Tevfik_Kursun]

Merhaba Arkadaş,
Sorunuzu şimdi gördüm. İstediğiniz bu mu acaba?
İyi çalışmalar
http://s5.dosya.tc/server3/eaebx6/Ornek_67.rar.html

 

[leylaz]

vardar07 kardeşim biçimlendirmede eksiklik var. Süzme ve bölme dondurma işlevini almıyor. Diğer biçimlendirmeler çok iyi.

Aşağıdaki kodla tekil çoğaltma yaparken süzme özelliği ve bölme/dondurma özelliği dahil birebir kopyalama yapıyordu.

Sheets("bos_").Copy After:=Sheets(Sheets.Count)
Sheets(Sheets.Count).Name = Sheets("Genel").Range("L6")

Tevfik_Kursun sizin dokümanı da inceledim. Sizin kodlamada sayfanın biçimlendirmelerini bozuyor.

 

[Tevfik_Kursun]

Evet Arkadaşım,
Ben de şimdi fark ettim bu durumu. Umarım çözülür. Çünkü bana da lazım, bu kısmı.
Kolay gelsin

 

[vardar07]

Komple değiştirip birde bu kodu deneyin.

Sub cogalt()
Dim syf As String
Dim bak As Range
With Sheets("Genel")
    For Each bak In .Range("C4:C" & .Range("C65536").End(3).Row)
  sayfa = .Cells(bak.Row, "C")
        If .Cells(bak.Row, "C") <> "" Then
 syf = sayfa
               If Not varmi(syf) Then                  
 Sheets("bos_").Copy After:=Sheets(Sheets.Count)
Sheets(Sheets.Count).Name = bak
 End If
End If
Next bak
End With
    MsgBox "İŞLEM TAMAMDIR"
End Sub

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

 

[leylaz]

Şimdi tamamdır. Allah razı olsun.