SAYFA KOPYALAMA

[bekir38]

merhaba arkadaşlar,

yaklaşık bir haftadır bir program üzerinde çalışıyorum. forum sayesinde belli bir seviyeye geldi, fakat sayfa kopyalamada takıldım kaldım. forma yazdım ama başlık değişikti herhalde dikkat çekmedi. o yüzden başlığı değiştirip tekrar yardım istiyorum. bir kitap içerisinde bir sayfadan ikinci bir sayfa ismi değiştirilerek makrolarla nasıl oluşturulur.
ekteki dosyada bir çalışma yaptım, sayfa ismini soruyor fakat kopyalarken resim olarak kopyalıyor. bir türlü çözemedim.
yardımlarınızı bekliyorum,

iyi çalışmalar,

 

[danersin]

Bu şekilde bir deneyin.

[vb:1:c793597555]Sub copypaste()
Dim Yeniisim As String
Yeniisim = InputBox("isim", "isim")
For i = 1 To Worksheets.Count
If Sheets(i).Name = Yeniisim Then
MsgBox ("bU İSİMDE saYfa zaten Var")
Exit Sub
End If
Next i
ActiveSheet.copy Before:=Worksheets("MALİYET")
On Error Resume Next
ActiveSheet.Name = Yeniisim
End Sub[/vb:1:c793597555]

 

[bekir38]

sayın danersin,

denedim ama döngüde hata verdi,
birde kopyalayacağım sayfada bazı satırları silmem gerekiyor,
benim gönderdiğim çalışmada buna benzer bir kod var ama silme aşamasında kodu kırıyor. kodu yanılmıyorsam resim olarak kopyaladığı için kırıyor.
ama niye resim kopyalıyor onu çözemedim.

iyi çalışmalar,

 

[bekir38]

arkadaşlar cevap gelmedi :yardim: :yardim: :yardim:

her türlü görüş ve öneriye ihtiyacım var. şu aşamada deneme yanılma yöntemiyle bulmaya çalışıyorum. :kafa:

tüm katılımcılarının desteğini bekliyorum, ost:

iyi çalışmalar,

 

[Levent Menteşoğlu]

Koddaki If Sheets(i).Name = Yeniisim Then satırını aşağıdaki gibi değiştirin.

If ucase(Sheets(i).Name) =ucase(Yeniisim) Then

 

[bekir38]

sayın leventm,

biraz önce kodları değiştirdim ama hata verdi.
For i = 1 To Worksheets.Count
bu döngüde kodu kırıyor,

iyi çalışmalar,

 

[Levent Menteşoğlu]

Bu döngüde hata vermesi mümkün değil, tek hatayı ActiveSheet.copy Before:=Worksheets("MALİYET") satırında verebilir oda eğer "MALİYET" isimli bir sayfa mevcut değilse

 

[bekir38]

Bu döngüde hata vermesi mümkün değil, tek hatayı ActiveSheet.copy Before:=Worksheets("MALİYET") satırında verebilir oda eğer "MALİYET" isimli bir sayfa mevcut değilse

bende hata veriyor sayın leventm,

maliyet isimli bir sayfada var ayrıca,
rica etsem siz yukarıda bulunan rar dosyası bendeki ile aynı, bu kodları o dosyada deneyebilirmisiniz. çünkü hata veriyor. :?

iyi çalışmalar,

 

[bekir38]

kopyalama ile ilgili kodlar aşağıdaki gibi;

Sub copypaste()

Cells.Select
Selection.copy
Application.Run "farklıkaydet"
Cells.Select
ActiveSheet.DropDowns.Add(144, 0.75, 63.75, 12).Select
ActiveSheet.Paste
Range("B45").Select
ActiveSheet.Shapes("AutoShape 4").Select
Application.CutCopyMode = False
Selection.Cut
ActiveSheet.Shapes("AutoShape 5").Select
Selection.Cut
ActiveSheet.Shapes("AutoShape 6").Select
Selection.Cut
ActiveSheet.Shapes("Drop Down 1").Select
Selection.Cut
ActiveSheet.Shapes("AutoShape 2").Select
Selection.Cut
ActiveSheet.Shapes("AutoShape 3").Select
Selection.Cut
Rows("1:3").Select
Selection.Delete Shift:=xlUp
Range("A1:A2").Select
Sheets("MALİYET").Select
Range("A2").Select
ActiveWorkbook.Save
End Sub
:yardim: :yardim: :yardim: :yardim: :yardim:
bir başka kod sayın "leventm" in gönderdiği kod,

Sub copypaste1()
Dim Yeniisim As String
Yeniisim = InputBox("isim", "isim")
For i = 1 To Worksheets.Count
If Sheets(i).Name = Yeniisim Then
MsgBox ("bU İSİMDE saYfa zaten Var")
Exit Sub
End If
Next i
ActiveSheet.copy Before:=Worksheets("MALİYET")
On Error Resume Next
ActiveSheet.Name = Yeniisim
End Sub
:yardim: :yardim: :yardim: :yardim: :yardim: :yardim:
bir başka kopyalama örneği ;
Sub farklıkaydet()

soru = MsgBox("Yeni Sayfamı Açacaksınız? ", vbYesNo, "Yeni Sayfa")
If soru = vbYes Then
SayfaAdi = InputBox("Lütfen Sayfa Adını Giriniz?", "Sayfa Adı")
If SayfaAdi = "" Then
Exit Sub
Else
Worksheets.Add
ActiveSheet.Name = SayfaAdi
End If
End If

End Sub

ama inanın hiç biri çalışmıyor, :yardim: :yardim: :yardim:
yardımlarınızı bekliyorum,

iyi çalışmalar,

 

[Levent Menteşoğlu]

Aşağıdaki kodu deneyin.

[vb:1:ef6f39fd44]Sub copypaste()
Dim sayfaad As String
sayfaad = InputBox("SAYFA İSMİNİ GİRİNİZ?", "SAYFA İSMİ VERME")
On Error GoTo 10
Sheets(sayfaad).Select
MsgBox "BU İSİMDE BİR SAYFA MEVCUTTUR"
Sheets("MALİYET").Select
Exit Sub
10 Sheets("MALİYET").Select
Sheets("MALİYET").copy After:=Sheets(Sheets.Count)
Sheets(Sheets.Count).Name = sayfaad
End Sub[/vb:1:ef6f39fd44]

 

[bekir38]

valla ellerinize sağlık,

çok güzel çalışıyor, hatta 10 sayfa sayısımıdır diye 11 defa farklı sayfa oluşturdum makro çalıştı.
yardımlarınız için çok çok teşekkürler, :hihoho: :hihoho: :hihoho:
proğramın son halini tamamlayım siteye ekleyeceğim, belki başkalarına yardım olur, ön ayak olur, referans olur,

sayın leventm, size ve bu proğrama emeği geçenlere, siteyi hazırlayanlara ve destek verenlere çok çok teşekkürler,

iyi çalışmalar,

 

[bekir38]

merhaba arkadaşlar, :hey:

proğramın son hali ektedir,
proğramda tüm kodlar açıktır. sadece ana sayfada koruma vardır.
sayfa koruması 1861 dir.

:hey: :hey: :hey: :hey: :hey: :hey: :hey:

iyi çalışmalar,