Makro ile sayfa adý kopyalama

[hakan]

Merhaba,

Uzunca bir makro ve next döngüsü ile 50 sayfalık bir excel dosyamı farklı
özelliklerle farklı bir excel dosyasına kopyalayabilir hale geldim ancak
sayfa adlarını kopyalayamadım. Yardımcı olabilirmisiniz ?

[Martyn]

Selam,
Sorunuzu biraz daha açabilir misiniz?
"ancak sayfa adlarını kopyalayamadım" derken tam olarak
yapmak istediğiniz nedir ve buna karşın olan biten nedir?

--
¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
A friend in need, is a friend indeed...
http://www.eserceker.com
___Zoom©
¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤

"hakan" <hakan.d...@mgeups.com.tr> wrote in message
news:Ogfrm2DP...@TK2MSFTNGP12.phx.gbl...

[hakan]

Merhaba, kastım şu : hani yeni bir excel dökümanı yarattığınızda sayfa
adları sayfa1, 2,3 gibi gelir. Benim dosyamda her sayfanın kendine özgü bir
adı var ve bu sayfaların içeriğini farklı bir noktaya farklı özelliklerle
periyodik olarak kopyalamam gerekiyor. Bu kısmını çözdüm, ancak sayfa
adlarını yeni dosyamda yarattığım ve içeriğini kopyaladığım sayfalara
kopyalayamıyorum. Açık olabildim mi acaba ?

Saygılarımla

"Martyn" <ay...@post.com> wrote in message
news:#wQoOILP...@tk2msftngp13.phx.gbl...

[Martyn]

Alttaki makro istediğiniz işi yapıyor. (Tarafımdan denenmiştir)
==============================================
Private Sub Workbook_Open()
' Bu makro ile kitapçıktaki tüm sayfalar
' kendi orijinal sayfa isimleri korunarak ve
' bu isimler kitapçık adı olarak kullanılarak
' saklanmalarını sağlıyor
Set shOrig = ActiveSheet
For Each sh In ActiveWorkbook.Worksheets
sh.Copy
ActiveWorkbook.SaveAs Filename:="C:\" & sh.Name & ".xls"
ActiveWorkbook.Close
Next sh
shOrig.Activate
End Sub
===============================================

"hakan" <hakan.d...@mgeups.com.tr> wrote in message

news:%23FL8xYn...@TK2MSFTNGP11.phx.gbl...

[Hakan DEMIRALP]

İlginize teşekkürler ancak vermiş olduğunuz makro her sayfayı ayrı ayrı
dosyalara kopyalıyor. Oysa benim amacım aslında yaklaşık 30 sayfalık bir
dosyayı başka insanlara gönderirken kullanmış olduğum formül ve formatlardan
bağımsız olarak farklı bir şekilde kaydederek göndermek ve bunun için
aşağıdaki makroyu hazırladım. Bununla birlikte kopyalamada sayfa adlarınında
geçmesini istiyorum. Yardımcı olabilirmisiniz ?

Sub Makro1()
'
' Makro1 Makro
' Makro Hakan DEMİRALP tarafından 30.04.2004 tarihinde kaydedildi.
'

'

Dim kaynakSayfa As Integer
Dim hedefSayfa As Integer
Dim toplamSayfa As Integer
Dim i As Integer
Dim ii As Integer

toplamSayfa = 31 'Kaynaktaki toplam sayfa sayisi

Workbooks.Add
ChDir "C:\WINDOWS\Desktop"
ActiveWorkbook.SaveAs
Filename:="C:\WINDOWS\Desktop\Yenifiyatlistesi.xls", FileFormat _
:=xlNormal, Password:="", WriteResPassword:="",
ReadOnlyRecommended:= _
False, CreateBackup:=False

For ii = 1 To 29
Select Case ii
Case 1 To 30
Windows("Yenifiyatlistesi.xls").Activate
Sheets.Add.[i]

End Select

Next ii

ActiveWorkbook.Save

For i = 1 To toplamSayfa
kaynakSayfa = i
Select Case i
Case 5 To 32 'Bu i?lemlerin uygulanacagi sayfalar
'Aralik belirtmek icin sayi1 to sayi2 kullanabilirsiniz
Windows("parcafiyat.xls").Activate
Sheets(kaynakSayfa).Select
Range("A:F").Select
Range("F26").Activate
Selection.Copy
Range("A1").Select
Windows("Yenifiyatlistesi.xls").Activate
'Bu kisim yeni sayfanin hedeftede yeni sayfaya kopyalanmasini
sa?layacak
hedefSayfa = hedefSayfa + 1
Sheets(hedefSayfa).Select
Range("A:F").Select
ActiveSheet.Paste
Selection.PasteSpecial Paste:=xlValues, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False
'Selection.PasteSpecial Paste:=xlFormats, Operation:=xlNone,
SkipBlanks:= _
'False, Transpose:=False
Application.CutCopyMode = False
ActiveWindow.DisplayGridlines = False
With ActiveSheet.PageSetup
.LeftHeader = ""
.CenterHeader = ""
.RightHeader = ""
.LeftFooter = ""
.CenterFooter = ""
.RightFooter = ""
.LeftMargin = Application.InchesToPoints(0.748031496062992)
.RightMargin = Application.InchesToPoints(0.748031496062992)
.TopMargin = Application.InchesToPoints(0.984251968503937)
.BottomMargin = Application.InchesToPoints(0.984251968503937)
.HeaderMargin = Application.InchesToPoints(0.511811023622047)
.FooterMargin = Application.InchesToPoints(0.511811023622047)
.PrintHeadings = False
.PrintGridlines = False
.PrintComments = xlPrintNoComments
.PrintQuality = 300
.CenterHorizontally = True
.CenterVertically = True
.Orientation = xlLandscape
.Draft = False
.PaperSize = xlPaperA4
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = 1
Range("A1").Select
End With

End Select

ActiveWorkbook.Save

Next i

End Sub

Saygılarımla

[Martyn]

Selam Hakan,
Makronuzda tek bir hata dışında bir sorun görmedim.
=====================================

For ii = 1 To 29
Select Case ii
Case 1 To 30
Windows("Yenifiyatlistesi.xls").Activate
Sheets.Add.[i]

End Select

Next ii
======================================
döngünüzde sanki 5. komut satırının

Sheets.Add.[ii]

şeklinde olması gerekiyor gibi !.
Sayfa isimlerinin de kopyalanması ile ilgili sorunun bundan kaynaklanıyor
olmasını dilerim.
Eğer bu düzeltme sonrasında da sorun buradan kaynaklanıyor değilse, o zaman
sayfadaki sadece belli bir bölgenin kopyalanmasından kaynaklanıyor olabilir.
O zaman da o komut yerine tüm sayfanın kopyalanmasını deneyebilirsiniz. Ama
siz yalnızca sayfalardaki belli bir alanı kopyalamak istiyor ve sayfanın
tümünü kopyalamak sizce mahsurlu ise o zaman sayfa adlarının da
kopyalanmasını sağlayacak özel komutlara ihtiyacınız var. Bu özel komutun ne
olduğunu henüz bilmiyorum. Ancak sayfanın tümü kopyalanıyor ise ismi ile
birlikte kopyalandığını biliyorum.
Umarım az da olsa yardımcı olabilmişimdir.
Saygılar

--
¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
A friend in need, is a friend indeed...
http://www.eserceker.com
___Zoom©
¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤

"Hakan DEMIRALP" <haka...@hotmail.com> wrote in message
news:eai9QbvQ...@TK2MSFTNGP12.phx.gbl...

---
Outgoing mail is certified Virus Free.
Checked by AVG anti-virus system (http://www.grisoft.com).
Version: 6.0.690 / Virus Database: 451 - Release Date: 22.05.2004

[Martyn]

yanıtlamadınız?

"Martyn" <ay...@post.com> wrote in message

news:#uYwtEyQ...@tk2msftngp13.phx.gbl...

Version: 6.0.692 / Virus Database: 453 - Release Date: 28.05.2004

[Hakan DEMIRALP]

Aslında yanıtladım ancak sanırım gönderirken bir problem olmuş.
YArdımınız için teşekkür ederim. Maalesef makrom normal çalışmasına rağmen
bahsettiğim problemi çözemedim. Bununla ilgili çözüme ulaşırsam bilgi
vereceğim.
Görüşmek üzere
Saygılar

"Martyn" <ay...@post.com> wrote in message

news:OeRi2#UREHA...@TK2MSFTNGP09.phx.gbl...

[Martyn]

Benden de selam ve saygılar...

"Hakan DEMIRALP" <haka...@hotmail.com> wrote in message

news:ObpJQyLT...@TK2MSFTNGP10.phx.gbl...