Dosyayı farklı kaydetme, Sayfa ismi değiştirme

[sarigozoglu]

Merhaba arkadaşlar

Set S1 = Sheets("a")
Set b1 = Sheets("b")
Set b2 = Sheets("c")
Set b3 = Sheets("d")
Set b4 = Sheets("e")
Set YOK = Sheets("f")

Makroda yukarıdaki şekilde tanımlamış sayfalarım var.
Sorgu/işlem bittiğinde en sonda bu sayfaları benim belirlyeceğim farklı dosya ve sayfa isimlerle ayrı ayrı kaydetmek istiyorum. Kaydedilecek yer özgün dosyanın olduğu klasör olacak.

Örneğin

(s1) sayfası, "Ankara" Sayfa İsmi ile "İç Anadolu" dosyasına
(b1) sayfası, "Balıkesir" Sayfa ismi ile "Marmara" dosyasına
.....
Şeklinde,


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

 

[PLİNT]

Merhaba
Aşağıdaki gibi deneyin.

[SIZE="2"]Sub kaydet()
s = Array("a", "b", "c", "d", "e", "f")
For a = 0 To UBound(s)
Set klasorsec = CreateObject("Shell.Application").BrowseForFolder(0, "Lütfen bir klasör seçin !", &H100)
yol = klasorsec.Items.Item.Path
If yol = Empty Then Exit Sub
 ChDir yol
 sor = InputBox(Prompt:="DOSYA ADI : ")
If sor = "" Then MsgBox "DOSYA ADI YAZMADINIZ": Exit Sub
kayıt = CreateObject("wscript.Shell").SpecialFolders.Item(yol) & _
sor & ".xlsx": Sheets(s(a)).Copy
    ActiveWorkbook.SaveAs Filename:=kayıt
    ActiveWorkbook.Close
Next
End Sub
 [/SIZE]

 

[sarigozoglu]

Merhaba emeğiniz için çok teşekkür ederim.

Fakat yapmak istediğim böyle manuel dosya ismi girilecek inputBox tarzı değil.
Ben işlemi kabaca aşağıdaki gibi yapıyorum ve vereceğim sayfa isimleri ile dosya isimleri sabit değişken değil. Fakat yapamadığım, seçtiğim sheet'i taşırken aynı zamanda sheet ismini değiştirerek taşımak.

Sheets("Başkent").Copy
ActiveWorkbook.SaveAs Filename:=fpath & "\" & İç Anadolu & ".xls", FileFormat:=xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, CreateBackup:=False
ActiveWindow.Close


Yapmak istediğim, "Başkent" i taşırken "Ankara" olarak yeni bir Excel dosyasına taşıyıp, dosya ismini de "İç Anadolu.xls" olarak kaydetmek

 

[PLİNT]

Şöyle olurmu?

[SIZE="2"]Private Sub CommandButton3_Click()
s = Array("Başkent", "Balıkesir", "Erzurum", "Konya")
ad = Array("Ankara", "Y_Balıkesir", "Y_Erzurum", "Y_Konya")
s2 = Array("İç Anadolu", "Marmara", "Doğu Anadolu", "İç Anadolu2")
For a = 0 To UBound(s)
Sheets(s(a)).Copy
ActiveSheet.Name = ad(a)
fpath = ThisWorkbook.Path
ActiveWorkbook.SaveAs Filename:=fpath & "\" & s2(a) & ".xls", FileFormat:=xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, CreateBackup:=False
ActiveWindow.Close
Next
End Sub[/SIZE]

sizin kodlarla;

[SIZE="2"]Private Sub CommandButton1_Click()
Sheets("Başkent").Copy
ActiveSheet.Name = "Ankara"
fpath = ThisWorkbook.Path
ActiveWorkbook.SaveAs Filename:=fpath & "\" & "İç Anadolu" & ".xls", FileFormat:=xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, CreateBackup:=False
ActiveWindow.Close
End Sub[/SIZE]

 

[sarigozoglu]

Çok teşekkür ederim. Emeğine sağlık.
Sizin seçeneğinizi kendi dosyama uyarladım, harika oldu.