Hello Again,
I am trying to save a selected worksheet as individual workbook on my desktop. Till here the script is working fine but the problem here is is is saving with formulas although i need to save only values not formulas. i have highlighted the part below in my script.
Can any one help me please.
Private Sub SaveExcel_Click()
n = LB1.ListCount
Dim MyFullName, DTAddress As String
Application.ScreenUpdating = False
Select_Sheets
DTAddress = CreateObject("WScript.Shell").SpecialFolders("Desktop") & Application.PathSeparator
DTAddress = DTAddress & Worksheets("ART NRP").Range("F2").Value & " " & Worksheets("ART NRP").Range("C2").Value
On Error Resume Next
MkDir DTAddress
DTAddress = DTAddress & "\"
For i = 1 To n
If LB1.Selected(i - 1) Then
With Sheets(LB1.List(i - 1))
If IsNull(.UsedRange.Text) Then
If ActiveSheet.Name = "Quotation (Arabic)" Then fname = Worksheets("ART NRP").Range("F2").Value & " " & "ARA Quot" & " " & Worksheets("ART NRP").Range("C2").Value & " " & ".xls"
If ActiveSheet.Name = "Template" Then fname = Worksheets("ART NRP").Range("F2").Value & " " & "Member Calculation" & " " & Worksheets("ART NRP").Range("C2").Value & " " & ".xls"
If ActiveSheet.Name = "ART NRP" Then fname = Worksheets("ART NRP").Range("F2").Value & " " & "NRP" & " " & Worksheets("ART NRP").Range("C2").Value & " " & ".xls"
If ActiveSheet.Name = "Calculation Result" Then fname = Worksheets("ART NRP").Range("F2").Value & " " & "Census With Premiums" & " " & Worksheets("ART NRP").Range("C2").Value & " " & ".xls"
.Copy
With ActiveWorkbook
Application.DisplayAlerts = 0
.Worksheets("ART NRP").Unprotect "******@aleem103"
.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
.SaveAs DTAddress & fname, 56
Application.DisplayAlerts = 1
.Close 0
End With
Response = MsgBox("The " & " " & ActiveSheet.Name & " " & " Successfully Save As EXL. Format" & vbCrLf + " " + vbCrLf + "Abdul Aleem - Lets Make Life Easier...", vbOKOnly + vbInformation, "Underwriting Department")
Else
Response = MsgBox("YOU CANNOT SAVE " & " " & ActiveSheet.Name & " " & "AS EXCEL BECAUSE" & " " & ActiveSheet.Name & " " & " " & "IS EMPTY OR RESTRICTED TO THE USER" & vbCrLf + " " + vbCrLf + "Abdul Aleem - Lets Make Life Easier...", vbOKOnly + vbInformation, "Underwriting Department")
End If
End With
End If
Next i
Application.ScreenUpdating = 1
End Sub
Bookmarks