Kopyala ve Klasöre Gönder...!!!

[ocamsul]

Arkadaşlar merhabalar Aşağıdaki kod ile belirlenmiş bir sayfayı kopyalayabiliyorum. Ancak bu Sayfanın C: de belilenmiş yada kod ile üretilmiş bir klasörün içine atıldıktan sonra mevcut çalışmanın içinde kopya olmamasını nasıl sağlayabilirim.

[COLOR="DarkGreen"]Sub BelırlıKopyala()
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", "Sayfa1")
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", "")
If ActiveSheet.Name = Empty Then Exit Sub
hata:
End Sub[/COLOR]

 

[ocamsul]

Fikir verecek yokmu dostlar.

 

[Recep İpek]

Yapmak istediğinizi tam olarak anlayamadım.

Siz mevcut bir sayfayı dosya olarak başka bir klasöre kaydetip, aktif olarak kullandığınız dosyadan da silinmesini mi istiyorsunuz?

 

[ocamsul]

SN: ripek üsdat

mevcut bir sayfayı belirlenmiş bir klasör (Örneğin TİF.File) olarak başka bir klasöre kaydetip, aktif olarak kullandığım dosya içine kaydedilmesin istiyorum. Yani bu kopyalama işi sadece belirttiğim klasörün içine tek sayfa olarak gönderilecek.

açıklama ve uygulama ektedir arkadaşlar. Umarım anlatabilmişimdir.

 

[ocamsul]

Arkadaşlar merhabalar.

Sorum ile ilgili fikri olan varmı dostlar.

Yapmak istediğim özetle: işlem yaptığımız Örneğin Sayfa1 i mevcut çalışma kitabının içine değilde örneğin C klasörüne yine macro ile oluşturulmuş DENEME klasörü içerisine sadece bahsettiğim Sayfa1 in kaydedilmesi ve mevcut çalışma kitabındaki Sayfa1 inde aynen kalmasını istiyorum.

 

[Recep İpek]

Aşağıdaki kodlar size fikir verebilir.

Sub CopySheets()
On Error GoTo Hata
sadi = InputBox("Kopyalanacak Sayfa Adını Giriniz", "UYARI", "Sheet1")
Sheets(sadi).Copy
ActiveWorkbook.SaveAs Filename:="C:\DENEME\AAA.XLS"
Application.Workbooks("AAA.XLS").Close
Exit Sub
Hata:
MsgBox "İlgili Sayfa Bulunamadı."
Exit Sub
End Sub

 

[ocamsul]

SN: ripek öncelikle ilginize ve verdiğiniz örnek için çok teşekkür ederim. Verdiğiniz kod işimi görüyor. Ancak; aşağıdaki satırın yani sayfaya verilen adın "AAA" olması bir sonraki kayıt denemesinde "bu noktada zaten bu isimde bir sayfa var yinede kaydetmek istiyormusunuz?" gibi bir soru alıyorum. bu durum için ne gibi bir çözümümüz olabilir? Saygılar.

Application.Workbooks("AAA.XLS").Close

başlangıçta bu bölüm doğru. Aynen kalması lazım.

sadi = InputBox("Kopyalanacak Sayfa Adını Giriniz", "UYARI", "Sheet1")

ama daha sonra kopyalanmak üzere olan sayfaya yeni bir InputBox ile yeni ad verebilmeliyiz ve verdiğimiz bu ad DENEME klasöründe var ise uyarı vererek "Bu konumda zaten bu isimde bir sayfa var" mesajı almamız benim yapmak istediğimdir arkadaşlar.

 

[Recep İpek]

Bunu deneyiniz.

Sub CopySheets()
On Error GoTo Hata
sadi = InputBox("Kopyalanacak Sayfa Adını Giriniz", "UYARI", "Sheet1")
yenisadi = InputBox("Yeni Sayfa Adını Giriniz", "UYARI", "Benim Sayfam")
son = yenisadi & ".xls"
Sheets(sadi).Copy
ActiveWorkbook.SaveAs Filename:="C:\DENEME\" & son
Application.Workbooks(son).Close
Exit Sub
Hata:
MsgBox "İlgili Sayfa Bulunamadı."
Exit Sub
End Sub

 

[ocamsul]

SN: ripek ilginize çok teşekkür ederim. Nerdeyse olacak desem yeridir. Olaki 2. InputBox da daha önce verilmiş ad verilir ise bu kodun iptal olması ve kayıt işlemini yapmaması ve daha önce bu dosya kaydedilmiş diye uyarıyı MsgBox ile verdirebilirmiyiz? yani bir kayıt adı 2. bir defa kullanılamasın.

Gelen uyarı mesajı excel in sistem mesajı değilde bizim hazırladığımız bir MsgBox olabilirmi?

 

[Recep İpek]

Aşağıdaki kodları kendinize göre uyarlayınız.

Sub CopySheets()
On Error GoTo Hata
sadi = InputBox("Kopyalanacak Sayfa Adını Giriniz", "UYARI", "Sheet1")
yenisadi = InputBox("Yeni Sayfa Adını Giriniz", "UYARI", "Benim Sayfam")
son = yenisadi & ".xls"
MyEnd = "C:\DENEME\" & son
Set ds = CreateObject("Scripting.FileSystemObject")
a = ds.FileExists(MyEnd)
If a = True Then
MsgBox "Bu isimde bir dosya var"
Else
Sheets(sadi).Copy
ActiveWorkbook.SaveAs Filename:=MyEnd
Application.Workbooks(son).Close
End If
Exit Sub
Hata:
MsgBox "İlgili Sayfa Bulunamadı."
Exit Sub
End Sub

 

[ocamsul]

Sn: ripek, üsdat tam istediğim gibi oldu. emeğine ve ilgine teşekkür ederim.