Şablonu Kopyalarken Farklı Kitaptaki Aynı Adlı Sayfadan Veri Alma.

[Olcay]

Merhabar arkadaşlar. Soracağım soruya muhtemelen daha önceden cevap verilmiştir ama sabah saat 7'den beri arama yaptığım halde bulamadım. Benim Sorunum şu:
Ekte iki tane dosya bulunuyor (c:\sablon klasöründe yer alacak ). Şablon Kopyala.xls dosyası sayfa1.xls dosyasındaki kısaltmalar listesini kullanarak bir liste oluşturuyor. Şablon kopyala kitabındaki Anasayfa sekmesindeki şablon aktar butonuyla da bu listedeki isimlerden oluşan ve şablon sayfasının biçim özelliklerini taşıyan yeni sayfalar oluşuyor.

Şablon kopyalama yaparken, sözgelimi sayfa1.xls kitabında bulunan AK ABDULLAH KULBAKLI sayfasında bulunan B5:I9 hücreleri arasındaki verileri şablon kopyala.xls kitabındaki AK ABDULLAH KULBAKLI sayfasının C10:J14 arasındaki hücrelerine kopyalayabilir mi? Daha açık söylemek gerekirse o an oluşturulan sayfa ismini sayfa1.xls dosyasından bularak buradaki verileri aktarabilir miyiz?

Yardımlarınız için şimdiden çok teşekkür ederim.

 

[Olcay]

Bahsettiğim karşılatırmanın örneklendiği bir konuya forumda rastlamadım. Eğer rastlayanınız varsa buraya bir link atabilir mi? Kendim uğraşarak birşeyler yapmak istiyorum ama aktif sayfayı başka kitapta bulacak kod konusunda sıkıntı yaşıyorum. Yardımcı olursanız çok sevinirim. Bu işlemi her eğitim öğretim yılında en az 10 kez yapıyorum ve her defasında yapılan tüm hesaplamalarla en az 4-5 saat vaktimi alıyor. Yardımlarınız için tekrar teşekkürler.

 

[Olcay]

(Affınıza sığınarak). Güncel.

 

[ENDMUH1]

İpucu

Sheets("AH ARZU HIDIR").Select
Windows("Sayfa1.xls").Activate
Sheets("AK ABDULLAH KULBAKLI").Select
Range("B5:I9").Select
Selection.Copy
Windows("şablon kopyala.xls").Activate
Range("C10").Select
Sheets("AK ABDULLAH KULBAKLI").Select
ActiveSheet.Paste

' Bu sadece 1 kayıdı yapabilir. Sheet isimlerini de döngüye alarak.."for i=1 to sheets.count"..gibi döndürerek tüm sayfaların bir benzerini şablon sayfanda oluşturabilir ve istediğin kısmını, istediğin kısma kaydedebilirsin..

'iyi çalışmalar

 

[Olcay]

Sayın ENDMUH cevabınız için çok teşekkür ederim. Ancak sayfa1.xls dosyasındaki sheet isimleri değişiklik gösterebiliyor. Öğretmen gelip gitmesi durumunda kodlar üzerinde değişiklik yapılması gerekecektir. Sayfa1.xls dosyası Dersmatik isimli ücretsiz ders dağıtım programın raporlaması olduğundan her dönem farklı öğretmen isimleri olacak. Bu raporlamayı direkt olarak yazıcıdan almak da pek sağlıklı sonuç vermiyor. Benim amacım burada ortaya çıkan çalışmayı kendi okulum için kullanmakla beraber internette yayınlamak. Kodları bahsettiğim şekilde verebilirseniz sadece bana değil pek çok müdür yardımcısına aynı anda yardım etmiş olacaksınız. İlginiz için tekrar teşekkürler.

 

[ENDMUH1]

Kodu aşağıdaki gibi güncellerseniz, istediğiniz gibi olur sanırım..

Sub Sayfa_olustur_sablon_kopyala()
On Error GoTo Hata
Set S1 = Sheets("ISIM") 'Isimleri aldığı sayfanın adı
template = "şablon kopyala.xls"
veri = "Sayfa1.xls"
For X = 2 To 1000
Windows(template).Activate
If S1.Cells(X, 3) <> "" Then
Sheets("şablon").Copy After:=Sheets(Sheets.Count)
ActiveSheet.Name = S1.Cells(X, 3)
Windows(veri).Activate
ShName = S1.Cells(X, 3) 'kopyalanacak sayfa adı
Sheets(ShName).Select
Range("B5:I9").Select
Selection.Copy
Windows(template).Activate
Sheets(ShName).Select
Range("C10").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End If
Next
S1.Select
MsgBox "İşleminiz tamamlanmıştır.", vbInformation
Exit Sub
Hata:
Application.DisplayAlerts = False
ActiveSheet.Delete
Application.DisplayAlerts = True
S1.Select
MsgBox "Aynı isimde sayfalar mevcuttur.", vbCritical, "DİKKAT !"
End Sub


iyi çalışmalar..

 

[Olcay]

Say&#305;n ENDMUH ilginiz beni &#231;ok mutlu etti. Ancak verdi&#287;iniz kodlar&#305; yazd&#305;&#287;&#305;mda Anasayfa sheeti siliniyor. "Activesheet.delete" sat&#305;r&#305;n&#305; sildi&#287;imde ise bir alttaki sat&#305;r (S1.Select) hata veriyor. Pek &#231;ok &#351;ey denedim ama kod bilgim olmay&#305;nca i&#231;inden &#231;&#305;kamad&#305;m. De&#287;erli vaktinizi ay&#305;r&#305;p ilgilendi&#287;iniz i&#231;in tekrar te&#351;ekk&#252;rler.

 

[ENDMUH1]

Dosya

Dosya ektedir. Her iki dosya açıkken çalıştırdığınızda sıkıntısız olarak çalışıyor. İyi çalışmalar.

 

[Olcay]

Tam istedi&#287;im gibi &#231;al&#305;&#351;&#305;yor, elinize sa&#287;l&#305;k. Yard&#305;m&#305;n&#305;z ve daha da &#246;nemli ilginiz i&#231;in &#231;ok te&#351;ekk&#252;r ederim. &#304;yi &#231;al&#305;&#351;malar.