Farklı Kaydet

[frk]

Herkese Selam,

Arkadaşlar, içinde 100 den fazla sayfası olan bir çalışma kitabım var. Bunlardan 1 tanesini ( Açık olan sayfayı ) , sayfa içinde ki bir hücrenin ( örn : B8 ) değeri ile aynı isimi taşıyacak şekilde, masaüstüne (veya farklı bir klasöre ) yeni bir çalışma kitabıymış gibi kaydedebilecek bir makro gerekiyor. Sayfa içindeki hücreler formüllerden oluşuyor, ama kaydederken hücrelerde gözüken değerler ile kaydetmesi gerekiyor, yardımcı olursanız memnun olurum.

 

[Tarkan VURAL]

Merhaba,

Aşağıdaki kodları dener misiniz ?

Private Sub kaydet()
'klasör açılıyor, dosya b8'den adını alıyor, dosya klasöre kaydediliyor,
    isim = Range("b8").Value
    Fname = isim & ".XLS"
    ActiveSheet.Copy
klasor = "frk_klasor"
Set ws = ActiveSheet
    Application.DisplayAlerts = False
ac:
    Set Fs = CreateObject("Scripting.FileSystemObject")
        If Fs.FolderExists("C:\" & klasor) Then
            GoTo devam
        Else
            Fs.CreateFolder ("C:\" & klasor)
            GoTo ac
        End If
devam:
With ws
        .SaveAs "c:\" & klasor & "\" & Fname
End With
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    ActiveWorkbook.Close
   MsgBox "Kayıt işleminiz tamamlandı. " & vbNewLine & _
    "lütfen kontrol ediniz    ", vbInformation, "B i l g i "
End Sub