VBA code to copy current worksheet and paste into a new worksheet. Then save new worksheet as new workbook. Then delete the new worksheet

[jeremypyle]

Hi,

I'm very new to VBA. Normally just work with formulas

I am trying to create a VBA code that does the following:

1) copy info from current worksheet
2) create then worksheet and paste into into that worksheet
3) Then save that new worksheet as a new workbook. I want the name of the new workbook to be the name of the new worksheet. ie. sheet3,sheet4, etc
4) once the new workbook has been created, I want to delete the new worksheet that was created in step 2

How can I do this?
Step 1 in my code works okay.
But step 2 doesn't work.
And step 3 I don't know how to create.

Please see my code below:



Sub Copy_current_sheet_into_a_new_sheet_then_save_new_sheet_as_new_workbook_then_delete_the_sheet_that_was_created()
'
' Macro5 Macro
'

' step 1 - copying info to new worksheet

Range("A1:L9999").Select
Range("H7").Activate
Selection.Copy
Sheets.Add After:=ActiveSheet
Cells.Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.ScreenUpdating = False
Range("H1").Select
Columns("H:H").ColumnWidth = 18.14
Columns("C:C").Select
Application.CutCopyMode = False
Selection.NumberFormat = "0"
Columns("H:H").Select
Selection.NumberFormat = "0"

' step 2 - Save new worksheet as a new workbook

Application.ScreenUpdating = False
Dim ws As Worksheet
ws.Copy
ActiveWorkbook.SaveAs ThisWorkbook.Path & "\" & ws.Name

' step 3 - now how do I delete the new worksheet that was created in step 1

End Sub

 

[AlphaFrog]

1) copy info from current worksheet
2) create then worksheet and paste into into that worksheet
3) Then save that new worksheet as a new workbook.


This line of code does all of the above...

ActiveSheet.Copy

It copies the active sheet as a new workbook with one sheet and it has all the data from the original.

The code below does that and then saves the workbook copy...

Sub Copy_Sheet_as_WB()
   
    ActiveSheet.Copy 'Copy the current sheet as a new workbook with one sheet
   
    'the ActiveSheet is now the copy
    ActiveSheet.UsedRange.Value = ActiveSheet.UsedRange.Value 'Convert all formulas as values
   
    'SaveAs .xlsx file
    Activeworkbbok.SaveAs ThisWorkbook.Path & "\" & ActiveSheet.Name, FileFormat:=52
   
    'Optional: close the workbook copy
    'ActiveWorkbook.Close SaveChanges:=False
End Sub

 

[VBE313]

Here is an updated code. You should try to avoid using Select as much as possible. I also am assuming that your sheet is named Sheet1. I removed you copying 1000+ cells and changed it to grab the last row in column L. You also do not need to delete the worksheet that you created, you can simply move it and save it as a new workbook.

Sub newWorkbook()
Dim lastRow As Long, strCells As String, relativePath As String
With Sheets("Sheet1") ' Change to your sheet name
    lastRow = .Cells(.Rows.Count, "L").End(xlUp).Row
    strCells = "A1:L" & lastRow
    .Range(strCells).Copy
    Sheets.Add After:=ActiveSheet
End With
With ActiveSheet
    .PasteSpecial
    Application.CutCopyMode = False
    .Range("C:C").NumberFormat = "0"
    .Range("H:H").ColumnWidth = 18.14
    .Range("H:H").NumberFormat = "0"
    .Move
    relativePath = ThisWorkbook.Path & "\" & ActiveSheet.Name
    ActiveWorkbook.SaveAs Filename:=relativePath
End With
End Sub

 

[jeremypyle]

1) copy info from current worksheet
2) create then worksheet and paste into into that worksheet
3) Then save that new worksheet as a new workbook.


This line of code does all of the above...

ActiveSheet.Copy

It copies the active sheet as a new workbook with one sheet and it has all the data from the original.

The code below does that and then saves the workbook copy...

Sub Copy_Sheet_as_WB()
 
    ActiveSheet.Copy 'Copy the current sheet as a new workbook with one sheet
 
    'the ActiveSheet is now the copy
    ActiveSheet.UsedRange.Value = ActiveSheet.UsedRange.Value 'Convert all formulas as values
 
    'SaveAs .xlsx file
    Activeworkbbok.SaveAs ThisWorkbook.Path & "\" & ActiveSheet.Name, FileFormat:=52
 
    'Optional: close the workbook copy
    'ActiveWorkbook.Close SaveChanges:=False
End Sub

Hi Rich, thanks so much. Doesn't seem to work with my excel. It comes up with an error on line:

Activeworkbbok.SaveAs ThisWorkbook.Path & "\" & ActiveSheet.Name, FileFormat:=52

 

[jeremypyle]

Hi Rich, thanks so much. Doesn't seem to work with my excel. It comes up with an error on line:

Activeworkbbok.SaveAs ThisWorkbook.Path & "\" & ActiveSheet.Name, FileFormat:=52

Hi Rich, thanks so much. Doesn't seem to work with my excel. It comes up with an error on line:

Activeworkbbok.SaveAs ThisWorkbook.Path & "\" & ActiveSheet.Name, FileFormat:=52

I have tried instead as the following code:

'SaveAs .xlsx file
ActiveWorkbook.SaveAs ThisWorkbook.Path & "\" & ActiveSheet.Name

however this saves as the original sheet name.

There is an error at the moment. Some of the formulas in the sheet are conditional upon the sheet name. And I am assuming that the new sheet that is created in the original workbook is named as the default. For example, if I create a new sheet in my workbook now, it will save as Sheet26

This is because I already have created 25 other sheets.

This is the name that I want it to be called

 

[jeremypyle]

Here is an updated code. You should try to avoid using Select as much as possible. I also am assuming that your sheet is named Sheet1. I removed you copying 1000+ cells and changed it to grab the last row in column L. You also do not need to delete the worksheet that you created, you can simply move it and save it as a new workbook.

Sub newWorkbook()
Dim lastRow As Long, strCells As String, relativePath As String
With Sheets("Sheet1") ' Change to your sheet name
    lastRow = .Cells(.Rows.Count, "L").End(xlUp).Row
    strCells = "A1:L" & lastRow
    .Range(strCells).Copy
    Sheets.Add After:=ActiveSheet
End With
With ActiveSheet
    .PasteSpecial
    Application.CutCopyMode = False
    .Range("C:C").NumberFormat = "0"
    .Range("H:H").ColumnWidth = 18.14
    .Range("H:H").NumberFormat = "0"
    .Move
    relativePath = ThisWorkbook.Path & "\" & ActiveSheet.Name
    ActiveWorkbook.SaveAs Filename:=relativePath
End With
End Sub

Thanks so much. This almost seems to work. However the newly created workbook is not values only.

The original sheet must first of all copy and paste into a new worksheet. Then the formulas must be converted to value only. And then the sheet must be saved as a new workbook.

In your code however the new workbook has formulas rather than values

 

[VBE313]

Sub newWorkbook()
Dim lastRow As Long, strCells As String, relativePath As String, arr() As Variant
Dim rowCount As Long, colCount As Long
With Sheets("Sheet1") ' Change to your sheet name
    lastRow = .Cells(.Rows.Count, "L").End(xlUp).Row
    strCells = "A1:L" & lastRow
    rowCount = .Range(strCells).Rows.Count
    colCount = .Range(strCells).Columns.Count
    arr = .Range(strCells).Value
    Sheets.Add After:=ActiveSheet
End With
With ActiveSheet
    .Cells(1, 1).Resize(rowCount, colCount).Value = arr
    .Range("C:C").NumberFormat = "0"
    .Range("H:H").ColumnWidth = 18.14
    .Range("H:H").NumberFormat = "0"
    .Move
    relativePath = ThisWorkbook.Path & "\" & ActiveSheet.Name
    ActiveWorkbook.SaveAs Filename:=relativePath
End With
End Sub

 

[jeremypyle]

Sub newWorkbook()
Dim lastRow As Long, strCells As String, relativePath As String, arr() As Variant
Dim rowCount As Long, colCount As Long
With Sheets("Sheet1") ' Change to your sheet name
    lastRow = .Cells(.Rows.Count, "L").End(xlUp).Row
    strCells = "A1:L" & lastRow
    rowCount = .Range(strCells).Rows.Count
    colCount = .Range(strCells).Columns.Count
    arr = .Range(strCells).Value
    Sheets.Add After:=ActiveSheet
End With
With ActiveSheet
    .Cells(1, 1).Resize(rowCount, colCount).Value = arr
    .Range("C:C").NumberFormat = "0"
    .Range("H:H").ColumnWidth = 18.14
    .Range("H:H").NumberFormat = "0"
    .Move
    relativePath = ThisWorkbook.Path & "\" & ActiveSheet.Name
    ActiveWorkbook.SaveAs Filename:=relativePath
End With
End Sub

Thank you so much for your help! It works great