Create New Sheet-Copy, Paste

[Leah]

I would like to do a workbook close event where a new workbook is created, and the active sheet gets copied and pasted to it. I also need it to paste the information in the cells only, not the functions.

Any ideas?

[Siddharth Rout]

I would like to do a workbook close event where a new workbook is created, and the active sheet gets copied and pasted to it. I also need it to paste the information in the cells only, not the functions.

Any ideas?

Please note that you may have to make relevant changes

Paste this in the before close event of the workbook from where you want to copy the data.

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Call CopyandSaveNew
End Sub

and paste this in a module

Sub CopyandSaveNew()
    'DECLARE OBJECTS
    Dim ApExcel As Object, WbExcel As Object, str1 As String, str2 As String
    
    'Predecide the name of the New workbook
    str1 = "NewBook.xls"
    str2 = ActiveWorkbook.Name
    
    On Error Resume Next
    
    Set ApExcel = GetObject(, "Excel.application") 'SEE IF ANY EXISTING EXCEL IS OPEN
        
    If ApExcel Is Nothing Then
        'IF NO INSTANCE OF EXCEL IS FOUND THEN CREATE ONE
        Set ApExcel = CreateObject("Excel.application")  'CREATE A NEW EXCEL APPLICATION
    End If

    ApExcel.Visible = True ' So you can see Excel
    
    'Add new workbook
    Set WbExcel = ApExcel.Workbooks.Add
            
    'Save the newly created workbook at the required path
    WbExcel.SaveAs "c:\temp\" & str1
    
    'Select the workbook from "where" you want to copy the code
    Windows(str2).Activate
    Sheets(1).Cells.Select
    Selection.Copy
    
    'Select the workbook where you want to copy the code
    Windows(str1).Activate
    Cells.Select
    ActiveSheet.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    
    'SAVE AND CLOSE WORKBOOK
    WbExcel.Save
    WbExcel.Close
    Set WbExcel = Nothing
        
    'QUIT EXCEL
    ApExcel.Quit
    Set ApExcel = Nothing

End Sub

Hope this helps...

[Leah]

Thank you. I forgot to ask. Will this also copy and paste the pictures I have on the old sheet?

[Siddharth Rout]

yes it will if you replace this line in the above code

ActiveSheet.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks 
        :=False, Transpose:=False

with

ActiveSheet.Paste 'but this will not paste values...

[Leah]

Okay, I need my user to do the saving. Actually, this little snippet here works perfectly, except that it copies and pastes the functions in the cells, and I can't have that, as the filepaths won't match.

Private Sub Workbook_BeforeClose(Cancel As Boolean)

Call CopyNew

End Sub
Sub CopyNew()
    
 With ActiveSheet
      .Select
      .Copy
      .Protect "fox4704"
   End With
    
End Sub

[Siddharth Rout]

Sub CopyNew()
With ActiveSheet
.Select
.Copy
.Protect "fox4704"
End With
End Sub

Is this code enough to do what you wanted???