Sayfa Kopyalama (Macro ile)

[ocamsul]

Arkadaşlar Merhaba.
Aşağıdaki macroyu kullanarak sayfa kopyalayabiliyorum. Ancak bu noktada sorun aynı isimli sayfa kopyalanmak istendiğinde uyarı veriyor bu sorun konusunda yardım ederseniz sevinirim.

Sub Kopyala()
Sheets("Sayfa1").Visible = True
Sheets("Sayfa1").Copy After:=Worksheets(Worksheets.Count)
NewPageName = InputBox("Kopyalamak Üzere Olduğunuz Sayfanın Adını Belirleyiniz...!!!")
ActiveWindow.ActiveSheet.Name = NewPageName
Sheets("Sayfa1").Visible = False
End Sub

 

[mehmett]

Aynı isimde iki sayfa olmaz.
Her kopyalamada farklı bir isim vermeniz gerekir.

 

[ocamsul]

Üstadım doğru ama bu çalışmayı başkaları kullanacak. benim istediğim bu hatayı engellemek.

 

[Levent Menteşoğlu]

Aşağıdaki gibi deneyin.

Sub Kopyala()
Sheets("Sayfa1").Visible = True
Sheets("Sayfa1").Copy After:=Worksheets(Worksheets.Count)
10 NewPageName = InputBox("Kopyalamak Üzere Olduğunuz Sayfanın Adını Belirleyiniz...!!!")
For a = 1 To Sheets.Count
If UCase(Sheets(a).Name) = UCase(NewPageName) Then
MsgBox "Seçtiğiniz sayfa adı mevcuttur yeniden deneyin."
GoTo 10
End If
Next
ActiveWindow.ActiveSheet.Name = NewPageName
End Sub

 

[ocamsul]

Arkadaşlar merhabalar. Öncelikle herkese iyi haftalar, iyi çalışmalar dilerim. Üsdat leventm nin vermiş olduğu sayfa kopyalama makrosunda InputBox un Cancel butonuna bastığımızda çıkmak için ne yapmam lazım, kodlar bu hali ile çıkış butonuna bastığımızda uyarı veriyor.
Ayrıca inputBox da sayfa adı girilmemiş ise Kopyalama işlemini yapmasın isterim.

 

[AS3434]

Sub Kopyala()
Sheets("Sayfa1").Visible = True
Sheets("Sayfa1").Copy After:=Worksheets(Worksheets.Count)
10 NewPageName = InputBox("Kopyalamak Üzere Olduğunuz Sayfanın Adını Belirleyiniz...!!!")
If NewPageName = cancel Then Exit Sub
For a = 1 To Sheets.Count
If UCase(Sheets(a).Name) = UCase(NewPageName) Then
MsgBox "Seçtiğiniz sayfa adı mevcuttur yeniden deneyin."
GoTo 10
End If
Next
ActiveWindow.ActiveSheet.Name = NewPageName
End Sub

 

[ocamsul]

Sn: AS3434 teşekkür ederim.
Ayrıca inputBox da sayfa adı girilmemiş ise Kopyalama işlemini yapmasın. Bu nasıl olacak?

 

[AS3434]

Faza makro bilgim yok ama şu kodları deneyin.

Sub Kopyala()
'EXCEL.WEB.TR
Dim i As Integer
Dim kopya
For i = 1 To Worksheets.Count
sayfa = Sheets(i).Name & vbNewLine & sayfa
Next i
kopya = InputBox("Kopyalamak İstediğiniz Sayfanın adını giriniz" _
& vbCrLf & sayfa, "Kopya", "Excel.Web.Tr")
If kopya = Empty Then Exit Sub
Sheets(kopya).Copy After:=Sheets(Worksheets.Count)
On Error GoTo hata
ActiveSheet.Name = InputBox("Sayfanın Adını Giriniz", _
"Yeni Sayfa Ad", "YeniSayfa Ekle")
hata:
End Sub

Açılan Pencereden Excel.Web.Tr yazan yere kopyalayacağınız sayfa adını yazın. İkinci açılan pencereye yeni sayfa adını yazın.

 

[ocamsul]

Arkadaşlar konuyu şöyle açıklamak isterim; Çalışmamda 1 tane üzerine veri kaydedilen bir sayfam var Sayfa adı "VERİ" bu sayfanın userform üzerinde KAYDET butonuna basıldığında ilgili sayfaya kaydı yapılıyor, ancak bu sayfanında aynı zamanda InputBox ile isim girilerek kopyasının alınması gerekiyor. Ancak sayfa adı girilmemiş ise de kopyasının alınmaması gerekiyor. Birde Inputbox da OK tuşununa basıldığında isim yok ise de kopyalama yapılmasın. yani kopyalamanın kriteri isim olması.

 

[AS3434]

bu sayfanında aynı zamanda InputBox ile isim girilerek kopyasının alınması gerekiyor. Ancak sayfa adı girilmemiş ise de kopyasının alınmaması gerekiyor. Birde Inputbox da OK tuşununa basıldığında isim yok ise de kopyalama yapılmasın. yani kopyalamanın kriteri isim olması.

Size ikinci yazdığım kodlar dediklerinizi yapıyor. İlave olarak kopyalanacak sayfa adını yazıp yeni sayfa adını vermediğniz zaman kopyalama yapmamasını istiyorsanız şu şekilde değiştirin.

Sub Kopyala()
'EXCEL.WEB.TR
Dim i As Integer
Dim kopya
For i = 1 To Worksheets.Count
sayfa = Sheets(i).Name & vbNewLine & sayfa
Next i
kopya = InputBox("Kopyalamak İstediğiniz Sayfanın adını giriniz" _
& vbCrLf & sayfa, "Kopya", "Excel.Web.Tr")
If kopya = Empty Then Exit Sub ' BURADA ZATEN KOPYALANACAK SAYFA ADINI GİRMEZSENİZ KOPYA ALMIYOR.
Sheets(kopya).Copy After:=Sheets(Worksheets.Count)
On Error GoTo hata
ActiveSheet.Name = InputBox("Sayfanın Adını Giriniz", _
"Yeni Sayfa Ad", "YeniSayfa Ekle")
If ActiveSheet.Name = Empty Then Exit Sub 'İLAVE
hata:
End Sub

 

[ocamsul]

SN: AS3434 teşekkür ederim.

 

[AS3434]

Aslında tam istediğiniz şekildeki gibi..
"Excel.Web.Tr"
"YeniSayfa Ekle"
alanlarını boş bırakabilirsiniz.

[COLOR="DarkGreen"]Sub Kopyala()
'EXCEL.WEB.TR
Dim i As Integer
Dim kopya
For i = 1 To Worksheets.Count
sayfa = Sheets(i).Name & vbNewLine & sayfa
Next i
kopya = InputBox("Kopyalamak İstediğiniz Sayfanın adını giriniz" _
& vbCrLf & sayfa, "Kopya", [COLOR="Blue"]""[/COLOR])
If kopya = Empty Then Exit Sub 
Sheets(kopya).Copy After:=Sheets(Worksheets.Count)
On Error GoTo hata
ActiveSheet.Name = InputBox("Sayfanın Adını Giriniz", _
"Yeni Sayfa Ad", [COLOR="blue"]""[/COLOR])
If ActiveSheet.Name = Empty Then Exit Sub 
hata:
End Sub[/COLOR]

 

[ocamsul]

Sn: AS3434 verdiğiniz kodlar işime yarıyor. Ancak; iki defa isim girmektense, kopyalanacak sayfayı belli hale getirsek daha iyi olacak. Yani her defasında aynı sayfa kopyalansın, ama sayfa ismi kayıt esnasında değiştirilebilsin.

 

[AS3434]

Aynı kodlar üzerinden giderek şöyle yapabilirsiniz. Avantajı kopyalamak için size iki kere inputbox vasıtasıyla soru soruyor olması.
.
.
.
kopya = InputBox("Kopyalamak İstediğiniz Sayfanın adını giriniz" _
& vbCrLf & sayfa, "Kopya", "BURAYA KOPYALANACAK SAYFA ADINI GİRİN")
.
.

 

[ocamsul]

Sn: AS3434 Evet haklısınız. Teşekkür ederim.

 

[Oxco777]

Merhabalar,

Ben "27032013" adlı Excel dosyamdaki sayfaların hepsinin "Ana Veriler" adlı Excel dosyama kopyalanmasını istiyorum.

Dim i As Long
For i = 1 To 100

Sheet(i).Copy After:
Next i

ana formatında olacak sanırım ama bir türlü çalıştıramadım kodu.

Yardımlarınız için teşekkürler.