Tüm sayfalari farkli kitaplar olarak açmak

[encrasicolus]

Merhaba,

Tek bir kitap halinde gelen 400 ü askin sayfayi ayri ayri kitaplar halinde kaydetmek istiyorum.

Ayrica kaydedereken isim olarak her sheetin belirli bir hucresinde mesela c3 hücresinde yazan text i alsin.

Yardimci olursaniz sevinirim.

Tesekkurler

 

[Recep İpek]

Aşağıdaki kodları kullanabilirsiniz.

Sub CopySheets()
For Each sadi In Worksheets
    Sheets(sadi.Name).Select
    son = [c3] & ".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.Name).Copy
            ActiveWorkbook.SaveAs Filename:=MyEnd
            Application.Workbooks(son).Close
        End If
Next
Set ds = Nothing
MsgBox "Bitti"
Sheets(1).Select
End Sub

 

[encrasicolus]

çok tesekkur ederimmm