kitap içindeki her sayfayı ayrı ayrı kitap olarak kaydetme

[swelyan]

Merhaba ,

Kitap içindeki yaklaşık 100 sayfayı ayrı ayrı kitap olacak şeklinde belirttiğim lokasyona kopyalıyorum.
Buraya kadar bir sıkıntı yok. Yalnız kopyaladığım bu kitaplar formuller ile beraber kopyalandığı için mail gonderdikten sonra karşı taraf haliyle bunları okuyamıyor.

Yapmak istediğim sayfaları kopyalarken ve kaydederken sadece sayı değerlerini kopyalasın. Aşağıdakli koda ne eklemem gerekiyor bunun için, teşekkür ederim.


Sub BreakItUp()
Dim sht As Worksheet
Dim NFName As String
Const WBPath = "C:\"

For Each sht In ActiveWorkbook.Worksheets
sht.Copy
NFName = WBPath & sht.Name & ".xls"
ActiveWorkbook.SaveAs Filename:=NFName, _
FileFormat:=xlNormal, CreateBackup:=False
ActiveWindow.Close
Next
End Sub

 

[mancubus]

deneyin

Sub BreakItUp()

Dim sht As Worksheet
Dim NFName As String
Const WBPath = "C:\"

For Each sht In ActiveWorkbook.Worksheets
    sht.Copy
    [COLOR="red"]ActiveSheet.UsedRange.Value = ActiveSheet.UsedRange.Value[/COLOR]
    NFName = WBPath & sht.Name & ".xls"
    ActiveWorkbook.SaveAs Filename:=NFName, _
        FileFormat:=xlNormal, CreateBackup:=False
    ActiveWindow.Close
Next
End Sub

 

[tahsinanarat]

Aşağıdaki kodu denermiiniz

Sub BreakItUp()
Dim sht As Worksheet
Dim NFName As String
Const WBPath = "C:\"
For Each sht In ActiveWorkbook.Worksheets
sht.Copy
NFName = WBPath & sht.Name & ".xls"
ActiveWorkbook.SaveAs Filename:=NFName, _
FileFormat:=xlNormal, CreateBackup:=False
On Error Resume Next
Dim formul As Range
For i = 1 To Worksheets.Count
For Each formul In Worksheets(i).UsedRange
formul = formul.Value
Next
Next i
ActiveWorkbook.Save
Application.Quit
Next
End Sub