VBA to copy a worksheet to a new workbook using same format for .xls files

[WStockel]

I need a VBA code to copy a worksheet to a new workbook using the same format. I only want to copy values and not formulas. Since this file will be emailed to a number of members I need it done in .xls format.

 

[JLGWhiz]

You do realize that .xls format is pre 2007 version of Excel, don't you? It seems odd that running 365 one would suggest saving in a retrograde format.

 

[GWteB]

It seems odd that running 365 one would suggest saving in a retrograde format.

... not if the "number of members" the OP is talking about have retrogade Office versions ?

Change both file path and worksheet name to suit your needs:

Public Sub CopySheet()
    
    Const cFullName As String = "C:\Users\Wstockel\Documents\NewBook.xls"   '  <<< change accordingly

    Dim oSht    As Worksheet
    With Application
        .ScreenUpdating = False
        ThisWorkbook.Worksheets("Sheet1").Copy                              '  <<< change accordingly
        Set oSht = ActiveSheet
        oSht.Cells.Copy
        oSht.Cells(1, 1).PasteSpecial Paste:=xlPasteValues
        .CutCopyMode = False
        oSht.Cells(1, 1).Select
        oSht.Parent.SaveAs Filename:=cFullName, FileFormat:=xlWorkbookNormal
        .ScreenUpdating = True
    End With
End Sub

 

[JLGWhiz]

... not if the "number of members" the OP is talking about have retrogade Office versions ?

That is true, but I like to clear the air on the issue first, then work on the code.
regards, JLG

 

[WStockel]

I'm writing the program for an older person who is running an old version of excel. They will be the one generating the new file that they will email to others that have old versions of excel.

 

[WStockel]

@GWteB So the code you sent is a macro in the target worksheet? If so I need it the other way. I need the source file to write the to new worksheet with just values and same formatting.

 

[WStockel]

it appears

... not if the "number of members" the OP is talking about have retrogade Office versions ?

Change both file path and worksheet name to suit your needs:

Public Sub CopySheet()
   
    Const cFullName As String = "C:\Users\Wstockel\Documents\NewBook.xls"   '  <<< change accordingly

    Dim oSht    As Worksheet
    With Application
        .ScreenUpdating = False
        ThisWorkbook.Worksheets("Sheet1").Copy                              '  <<< change accordingly
        Set oSht = ActiveSheet
        oSht.Cells.Copy
        oSht.Cells(1, 1).PasteSpecial Paste:=xlPasteValues
        .CutCopyMode = False
        oSht.Cells(1, 1).Select
        oSht.Parent.SaveAs Filename:=cFullName, FileFormat:=xlWorkbookNormal
        .ScreenUpdating = True
    End With
End Sub

I got this code to work. But how do I modify this line of code so it creates the new workbook on the same path as the source worksheet if I don't know the path?

 

[JLGWhiz]

Well, you could assume that they will be saving to the same directory that the host workbook is in, so use the path for that workbook.

Dim fPath As String
fPath = ThisWorkbook.Path & "\"

Then use fPath wherever the path is needed in the code.
Otherwise, you will have to contact whoever you are doing it for and ask them for the path to use.

 

[WStockel]

Well, you could assume that they will be saving to the same directory that the host workbook is in, so use the path for that workbook.

Dim fPath As String
fPath = ThisWorkbook.Path & "\"

Then use fPath wherever the path is needed in the code.
Otherwise, you will have to contact whoever you are doing it for and ask them for the path to use.

So the whole line would be:
fPath = ThisWorkbook.Path & "\" & NewFileName.xls

 

[GWteB]

Public Sub CopySheet()
    Dim oSht        As Worksheet
    Dim sFullName   As String
    
    sFullName = ThisWorkbook.Path & "\NewBook.xls"   '  <<<<<
    
    With Application
        .ScreenUpdating = False
        ThisWorkbook.Worksheets("Sheet1").Copy       '  <<< change accordingly
        Set oSht = ActiveSheet
        oSht.Cells.Copy
        oSht.Cells(1, 1).PasteSpecial Paste:=xlPasteValues
        .CutCopyMode = False
        oSht.Cells(1, 1).Select
        oSht.Parent.SaveAs Filename:=sFullName, FileFormat:=xlWorkbookNormal
        .ScreenUpdating = True
    End With
End Sub