Vba to save specific sheet from my workbook only as value and formating

[MoKDiab]

Hello
I've tried many codes to make a macro to save my sheet with only value and formating I found one that works great but I faced one problem that the new saved sheet is from left to right and my source one is from right to left so I need your help to modify this code to save from right to left like the source sheet
This the code I used

plementing Fullscreen mode would be more complicated. Full screen mode affects the instance of the Excel application, not the individual workbooks. In order to do that, you would need to have this procedure enter an workbook_open procedure in the DestBook workbook module to set Application.DisplayFullScreen = True. You probably would want an workbook_BeforeClose procedure to set it to False. This would require the user accepting the macro warning when opening the file.

Code:
Sub SaveValues()
Dim SourceBook As Workbook, DestBook As Workbook, SourceSheet As Worksheet, DestSheet As Worksheet

Dim SavePath As String, i As Integer

Application.ScreenUpdating = False

Set SourceBook = ThisWorkbook

'*********************************************
'Edit next two lines as necessary
SavePath = Sheets("Sheet1").Range("F7").Text
Set SourceSheet = SourceBook.Sheets("Sheet3")
'*********************************************
Set DestBook = Workbooks.Add
Set DestSheet = DestBook.Worksheets.Add

Application.DisplayAlerts = False
For i = DestBook.Worksheets.Count To 2 Step -1
DestBook.Worksheets(i).Delete
Next i
Application.DisplayAlerts = True

SourceSheet.Cells.Copy
With DestSheet.Range("A1")
.PasteSpecial xlPasteValues
.PasteSpecial xlPasteFormats 'Delete if you don't want formats copied
End With

DestSheet.Name = SourceSheet.Name
DestBook.Activate
With ActiveWindow
.DisplayGridlines = False
.DisplayWorkbookTabs = False
End With
SourceBook.Activate

Application.DisplayAlerts = False 'Delete if you want overwrite warning
DestBook.SaveAs Filename:=SavePath
Application.DisplayAlerts = True 'Delete if you delete other line

SavePath = DestBook.FullName
DestBook.Close 'Delete if you want to leave copy open
MsgBox ("A copy has been saved to " & SavePath)

End Sub


Thanks

 

[StephenCrump]

... I faced one problem that the new saved sheet is from left to right and my source one is from right to left ....

Welcome to the Forum!

Can you explain further what you mean by left to right?

Your code copies the values and formatting of one sheet ("Sheet3") into a new workbook and saves and closes the new workbook.

Are you saying you want a different sheet to be copied? Perhaps more than one sheet?

 

[MoKDiab]

Thanks for replying
My sheet's language is Arabic so the page layout I use is from right to left

But when I use this Vba it makes
It saves the new sheet from left to right so all the Data get reversed.

 

[StephenCrump]

My sheet's language is Arabic ....

I thought that might be what you meant. But I am surprised that if you are using right-to-left as a default, a new workbook would open left-to-right. Perhaps you alternate between both?

I suggest that before the code line: Set DestBook = Workbooks.Add
you insert a new code line: Application.DefaultSheetDirection = xlRTL

And if you want to default back to left to right, insert a new code line at the end of the Sub: Application.DefaultSheetDirection = xlLTR

 

[MoKDiab]

It works great
Thank you.
I have a further Q
What If I want to save all the sheets in the active workbook as values in a new workbook Not individually.

 

[MoKDiab]

I need all sheets in just one workbook as values and formatting only

 

[StephenCrump]

It works great
Thank you.

Great, I'm glad we could help.

I have a further Q
What If I want to save all the sheets in the active workbook as values in a new workbook Not individually.

Try:

Sub SaveValues()

    Dim SourceBook As Workbook, DestBook As Workbook, SourceSheet As Worksheet, DestSheet As Worksheet
    Dim SavePath As String
    Dim LastRow As Long, i As Long, count As Long
    
    Application.ScreenUpdating = False
    
    Set SourceBook = ThisWorkbook
    
    '*********************************************
    'Edit next two lines as necessary
    SavePath = Sheets("Sheet1").Range("F7").Text
    Set SourceSheet = SourceBook.Sheets("Sheet3")
    '*********************************************
    
    Application.DefaultSheetDirection = xlRTL   'if necessary
    Set DestBook = Workbooks.Add
    
    Application.DisplayAlerts = False
    For i = DestBook.Worksheets.count To 2 Step -1
        DestBook.Worksheets(i).Delete
    Next i
    Set DestSheet = DestBook.Worksheets(1)
    Application.DisplayAlerts = True
    
    count = 1
    For Each SourceSheet In SourceBook.Worksheets
        With SourceSheet
            LastRow = .Cells.Find(What:="*", SearchOrder:=xlRows, SearchDirection:=xlPrevious, LookIn:=xlFormulas).Row
            .Range("1:" & LastRow).Copy
            With DestSheet.Range("A" & count)
                .PasteSpecial xlPasteValues
                .PasteSpecial xlPasteFormats
            End With
            count = count + LastRow
        End With
    Next SourceSheet
    
    DestSheet.Name = "Some name"
    DestBook.Activate
    With ActiveWindow
        .DisplayGridlines = False
        .DisplayWorkbookTabs = False
    End With
    SourceBook.Activate
    
    Application.DisplayAlerts = False 'Delete if you want overwrite warning
    DestBook.SaveAs Filename:=SavePath
    Application.DisplayAlerts = True 'Delete if you delete other line
    
    SavePath = DestBook.FullName
    DestBook.Close 'Delete if you want to leave copy open
    MsgBox ("A copy has been saved to " & SavePath)
    Application.DefaultSheetDirection = xlLTR   'if necessary

End Sub

 

[MoKDiab]

Thanks for replying
after editing the code to start saving the work book from sheet1 to the last sheet it gives me an error at lind 14
Set SourceSheet = SourceBook.Sheet1

I tried to remove it it works but it just save on sheet at the new workbook I need it to save all the sheets in just one workbook as values
thanks

Sub SaveValues()

    Dim SourceBook As Workbook, DestBook As Workbook, SourceSheet As Worksheet, DestSheet As Worksheet
    Dim SavePath As String
    Dim LastRow As Long, i As Long, count As Long
    
    Application.ScreenUpdating = False
    
    Set SourceBook = ThisWorkbook
    
    '*********************************************
    'Edit next two lines as necessary
    SavePath = Sheet1.Range("BC2").Text
    Set SourceSheet = SourceBook.Sheet1
    '*********************************************
    
    Application.DefaultSheetDirection = xlRTL   'if necessary
    Set DestBook = Workbooks.Add
    
    Application.DisplayAlerts = False
    For i = DestBook.Worksheets.count To 2 Step -1
        DestBook.Worksheets(i).Delete
    Next i
    Set DestSheet = DestBook.Worksheets(1)
    Application.DisplayAlerts = True
    
    count = 1
    For Each SourceSheet In SourceBook.Worksheets
        With SourceSheet
            LastRow = .Cells.Find(What:="*", SearchOrder:=xlRows, SearchDirection:=xlPrevious, LookIn:=xlFormulas).Row
            .Range("1:" & LastRow).Copy
            With DestSheet.Range("A" & count)
                .PasteSpecial xlPasteValues
                .PasteSpecial xlPasteFormats
            End With
            count = count + LastRow
        End With
    Next SourceSheet
    
    DestSheet.Name = "Some name"
    DestBook.Activate
    With ActiveWindow
        .DisplayGridlines = False
        .DisplayWorkbookTabs = False
    End With
    SourceBook.Activate
    
    Application.DisplayAlerts = False 'Delete if you want overwrite warning
    DestBook.SaveAs Filename:=SavePath
    Application.DisplayAlerts = True 'Delete if you delete other line
    
    SavePath = DestBook.FullName
    DestBook.Close 'Delete if you want to leave copy open
    MsgBox ("A copy has been saved to " & SavePath)
    Application.DefaultSheetDirection = xlLTR   'if necessary

End Sub

 

[StephenCrump]

Sorry, you can delete that line. It's no longer necessary.

Rather than copying one worksheet: Worksheets("Sheet3") in my version of the code, or Sheet1 in your version, we are now looping through all worksheets:

For Each SourceSheet In SourceBook.Worksheets

By the way, the error occurs because VBA won't let you refer to SomeWorkbook.SomeSheetCodeName.

There are workarounds to refer to a worksheet in another workbook by its codename, but in this case you could have said:

Set SourceSheet = Sheet1

(because SourceBook = ThisWorkBook).

 

[MoKDiab]

Ialready tried that but it only saves sheet 1 only on the new workbook and doesn't save all the other tabs.