oluşturulan yeni kitaba istenen ismin kodlarla alması

[numan şamil]

Merhaba arkadaşlar
ekli dosyada yeni yeni excel kitabı oluştururken aktar sayfasının A1 hücresinde ne yazılı ise yeni oluşan kitabın ismi olmasını ancak kaydedilecek yeri benim belirlememi istiyorum Bunun için excel kitabı oluştur düğmesine ait 3.modüldeki kodları nasıl revize edebilirim?
iyi çalışmalar

 

[halit3]

Bu konu ile ilgili bir sürü örnek var arama yaparsanız birşeyler bulabilirsiniz.
örnek link aşağıda
http://www.excel.web.tr/f133/klasor-ve-dosya-olu-turma-secenekleri-t68040.html

Sub çalışmakitabıyap()
deger = InputBox("dosyanın adı adını değiştirebilirsiniz.", "UYARI!", ActiveSheet.Name)
deger1 = InputBox("Sayfanın adını değiştirebilirsiniz.", "UYARI!", "sayfa1")
'dosya_adı = ActiveWorkbook.Name
Sayfa_Adı = ActiveSheet.Name
On Error Resume Next
Dim Baslik As String
Baslik = "Kaynak Dosyaları İçeren Klasörü Seçin"
Set Obj = CreateObject("shell.application")
Set Klasor = Obj.BrowseForFolder(0, Baslik, 50, &H0)
Kaynak = Klasor.SELF.Path
If Not Klasor Is Nothing Then
If InStr(1, Kaynak, "{") > 0 Then GoTo Atla
For i = Len(ThisWorkbook.Name) To 1 Step -1
If Mid(ThisWorkbook.Name, i, 1) = "." Then
Dosya_adi = Mid(ThisWorkbook.Name, 1, i - 1)
Uzanti = Mid(ThisWorkbook.Name, i, Len(ThisWorkbook.Name))
Exit For
End If
Next
If Right(Kaynak, 1) = "\" Then
Kaynak = Kaynak
Else
Kaynak = Kaynak & "\"
End If
On Error Resume Next
Dim sayfa As Worksheet
For Each sayfa In Worksheets
MsgBox Worksheets
If sayfa.Name = Sayfa_Adı Then
sayfa.Copy
Sheets(ActiveSheet.Name).Name = deger1
ActiveWorkbook.SaveAs Kaynak & deger & Uzanti
ActiveWorkbook.Close False
Exit Sub
End If
Next sayfa
Else
Atla:
MsgBox "Lütfen Kaynak Klasör Seçimini Yapınız !", vbInformation, "DİKKAT"
End If

End Sub

 

[numan şamil]

Halit bey teşekkür ederim
dosyamda Aktar sayfası değilde sayfa1 'in kopyasından çalışma kitabı oluşturmam gerekiyordu kolarınızdaki (sayfa.Copy' i sayfa1.Copy) şeklinde değiştirdim bu oldu bir istediğim dosya isminin aktar adlı sayfanın ismi değilde aktar adlı sayfadaki A1 hücresinde yazan isim uyarı kutusuna yazması bunun için kodlarınızda nereyi değiştireceğimi bilemiyorum
iyi çalışmalar

 

[halit3]

deger = InputBox("dosyanın adı adını değiştirebilirsiniz.", "UYARI!", ActiveSheet.Name)

Yukarıdaki kırmızı yazan yeri değiştirmeniz yeterli

deger = InputBox("dosyanın adı adını değiştirebilirsiniz.", "UYARI!", Range("a1").Value)

 

[numan şamil]

Çok teşekkür ederim iyi çalışmalar