Sayfaları Kitaplara Ayırma..

[bulentkars]

Arkadaşlar Merhaba

Aşağıdaki makro yu çalışma sayfasında çalıştırabılıyorum fakat xla.eklentıde calıstırdımda ham.Sheets(i).Copy satırında hata verıyor acaba xla da calıstıramıyormuyum yardımcı olursanız sevınırm


Sub Kitaplara_Ayir()


Set ham = ThisWorkbook
For i = 3 To Worksheets.Count
ham.Sheets(i).Copy
ActiveWorkbook.SaveAs "C:\Magazalar\" & ham.Worksheets(i).Name
ActiveWorkbook.Close
Next i
End Sub

 

[halit3]

dosya nerede ise dosyanın yanınna kitapları oluşturur
aşağıdaki kodu denermisiniz

Sub dosyaoluştur()
For i = 1 To ActiveWorkbook.Sheets.Count
dosya_adı = Sheets(i).Name
On Error Resume Next
Dim ExcelSheet As Object
Set ExcelSheet = CreateObject("Excel.Sheet")
ExcelSheet.SaveAs ThisWorkbook.Path & "\" & dosya_adı & ".xls"
Set ExcelSheet = Nothing
Next
End Sub

 

[halit3]

ekli dosyaya bakınız