Save worksheet as new macro-enabled Workbook

tlc53

tlc53

Active Member
Joined
Jul 26, 2018
Messages
399
Hi,

I nearly have this working. I want sheet 12 (called Journal) to be copied and saved into a new macro-enabled workbook. It's getting stuck at the save part, saying "The following features cannot be saved in macro-free workbooks: VB project"

Code: 
Sub New_Journal()
     Dim wb As Workbook
    Set wb = Workbooks.Add
    ThisWorkbook.Sheets("Journal").Copy Before:=wb.Sheets(1)
    wb.SaveAs "C:\Users\Andrew\Documents\JournalNEW.xlsm"
End Sub

Can someone please tell me where I am going wrong? Thanks!
 

Excel Facts

Format cells as time
Select range and press Ctrl+Shift+2 to format cells as time. (Shift 2 is the @ sign).
Sort by date Sort by votes
Try this

tlc53 said:
Hi,

I nearly have this working. I want sheet 12 (called Journal) to be copied and saved into a new macro-enabled workbook. It's getting stuck at the save part, saying "The following features cannot be saved in macro-free workbooks: VB project"

Code: 
Sub New_Journal()
     Dim wb As Workbook
    Set wb = Workbooks.Add
    ThisWorkbook.Sheets("Journal").Copy Before:=wb.Sheets(1)
    wb.SaveAs "C:\Users\Andrew\Documents\JournalNEW.xlsm"[COLOR=#ff0000], FileFormat:=xlOpenXMLWorkbookMacroEnabled[/COLOR]
End Sub

Can someone please tell me where I am going wrong? Thanks!
Click to expand...
 
Last edited:
Upvote 0
Thanks Dante! :) That fixed the problem.

I have been compiling my VBA macro but there's a couple of things that aren't working correctly.

Firstly, when it moves the "Journal" tab over onto a new sheet, I then ask that it deletes "Sheet1" from the newly created workbook. However, it asks for manual confirmation (Are you sure you want to delete Sheet1). How can I amend the code to say yes, delete the sheet.

Secondly, when the new "Journals" tab is created, there's 4x user macro buttons. However, the macro buttons refer to the original "E3 Sheet" instead of running the macros based on the data in the new "Journals" spreadsheet. You will see I tried re-assigning the macro's to the buttons but this doesn't appear to have worked.

Lastly, instead of writing the file name save and locations (wb.SaveAs "C:\Users\Andrew\Documents\Journals YE 31 May 2019.xlsm") how can I amend this to refer to the file name and location stated in cell K1 (which is formulated)?

Really appreciate your help. Thanks!

Code: 
Sub E3_Journal_1_New()
'
' E3_Journal_1_New Macro
'


'
    Sheets("E3").Select
    Sheets("Journal").Visible = True
    Sheets("Journal").Select
    Range("C6:E7").Select
    Selection.Copy
    Range("C6:E6").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("C8").Select
    Application.CutCopyMode = False
    Sheets("E3").Select
    ActiveWindow.SmallScroll Down:=27
    Rows("48:61").Select
    Selection.EntireRow.Hidden = False
    Range("A36:M46").Select
    Application.CutCopyMode = False
    Selection.Copy
    ActiveWindow.SmallScroll Down:=12
    Range("A49").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    ActiveWindow.SmallScroll Down:=-6
    Range("B37:B46").Select
    Application.CutCopyMode = False
    Selection.ClearContents
    Range("E37:J46").Select
    Selection.ClearContents
    Range("M37:M46").Select
    Selection.ClearContents
    Rows("50:59").Select
    Selection.Copy
    Sheets("Journal").Select
    Rows("12:12").Select
    Selection.Insert Shift:=xlDown
    Range("A12:N21").Select
    Application.CutCopyMode = False
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlHairline
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlHairline
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlHairline
    End With
    With Selection.Font
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
    End With
    Range("N12:N21").Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThick
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlHairline
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlHairline
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlHairline
    End With
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent2
        .TintAndShade = 0.799981688894314
        .PatternTintAndShade = 0
    End With
    Range("A12").Select
    Dim wb As Workbook
    Set wb = Workbooks.Add
    ThisWorkbook.Sheets("Journal").Copy Before:=wb.Sheets(1)
    wb.SaveAs "C:\Users\Andrew\Documents\Journals YE 31 May 2019.xlsm", FileFormat:=xlOpenXMLWorkbookMacroEnabled
    
    Windows("Journals YE 31 May 2019.xlsm").Activate
    ActiveSheet.Shapes.Range(Array("Button 4")).Select
    Selection.OnAction = "Sheet12.Delete_Blank_Rows"
    ActiveSheet.Shapes.Range(Array("Button 2")).Select
    Selection.OnAction = "Sheet12.ResetFilters"
    ActiveSheet.Shapes.Range(Array("Button 3")).Select
    Selection.OnAction = "Sheet12.Unposted_Journals"
    ActiveSheet.Shapes.Range(Array("Button 1")).Select
    Selection.OnAction = "Sheet12.Search_For_Date"
    Sheets("Sheet1").Select
    ActiveWindow.SelectedSheets.Delete
    Range("A12").Select
    ActiveWindow.SmallScroll Down:=-15
    ActiveWorkbook.Save
    ActiveWindow.Close
    Sheets("Journal").Select
    ActiveWindow.SelectedSheets.Visible = False
    Sheets("E3").Select
    Range("A49:M60").Select
    Selection.Locked = True
    ActiveWindow.SmallScroll Down:=-12
    Range("B37").Select
End Sub
 
Upvote 0
Change this
Code: 
    Dim wb As Workbook
    Set wb = Workbooks.Add
    ThisWorkbook.Sheets("Journal").Copy Before:=wb.Sheets(1)
    wb.SaveAs "C:\Users\Andrew\Documents\Journals YE 31 May 2019.xlsm", FileFormat:=xlOpenXMLWorkbookMacroEnabled
    
    Windows("Journals YE 31 May 2019.xlsm").Activate
    ActiveSheet.Shapes.Range(Array("Button 4")).Select
    Selection.OnAction = "Sheet12.Delete_Blank_Rows"
    ActiveSheet.Shapes.Range(Array("Button 2")).Select
    Selection.OnAction = "Sheet12.ResetFilters"
    ActiveSheet.Shapes.Range(Array("Button 3")).Select
    Selection.OnAction = "Sheet12.Unposted_Journals"
    ActiveSheet.Shapes.Range(Array("Button 1")).Select
    Selection.OnAction = "Sheet12.Search_For_Date"
    Sheets("Sheet1").Select
    ActiveWindow.SelectedSheets.Delete
    Range("A12").Select
    ActiveWindow.SmallScroll Down:=-15
    ActiveWorkbook.Save
    ActiveWindow.Close
    Sheets("Journal").Select
    ActiveWindow.SelectedSheets.Visible = False

by this:
Code: 
    Application.DisplayAlerts = False
    Application.SheetsInNewWorkbook = 1
    Dim wb As Workbook
    Dim wName As String
    wName = Sheets("Journal").Range("K1").Value
    ThisWorkbook.Sheets("Journal").Copy
    Set wb = ActiveWorkbook
    wb.SaveAs wName, FileFormat:=xlOpenXMLWorkbookMacroEnabled
    wb.Close False
    
    Sheets("Journal").Visible = False
    Sheets("E3").Select
    Range("A49:M60").Locked = True

perform a test of the execution of the buttons on the new sheet. according to me they should run in the new book without problem.


in cell K1 you should have the path, the name of the file and the extension, something like this:

C:\Users\Andrew\Documents\Journals YE 31 May 2019.xlsm
 
Upvote 0
Thanks. Everything's working fine except the buttons. They still seem to be running on the "E3" Sheet instead of the new "Journal" sheet.
I tried locating the macros on Sheet 12 (Journal tab), I also tried under a Module and then I tried ThisWorkbook. Each time, the new file keeps referring to the "E3" sheet. I can also see it's doing this when I right click on the button, in the new Journal sheet, the marco assigned is "'E3 Other Income.xlsm'!Sheet12.Delete_Blank_Rows" for eg.
Also, if I have sheet E3 closed and click on one of the macro buttons in the new Journal sheet, it opens the E3 Workbook.

I'm running out of things to try. Here are the macro button codes..

Code: 
Sub ResetFilters()
    On Error Resume Next
    ActiveSheet.ShowAllData
End Sub


Sub Search_For_Date()
'Modified 11/20/2018 12:29:04 AM  EST
Application.ScreenUpdating = False
Dim i As Long
Dim LastRow As Long
LastRow = Cells(Rows.Count, "N").End(xlUp).row
For i = 12 To LastRow
    If Cells(i, "N") = "" Then Cells(i, "N").Value = Date
Next
Application.ScreenUpdating = True
End Sub




Sub Delete_Blank_Rows()


    Dim lngLastRow As Long
    Dim lngMyRow As Long
    Dim xlnCalcMethod As XlCalculation
    
    With Application
        .ScreenUpdating = False
        xlnCalcMethod = .Calculation
        .Calculation = xlCalculationManual
    End With
    
    lngLastRow = Range("A:L").Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).row
    
    'Work backwards through the rows from the last row found to Row 12.
    For lngMyRow = lngLastRow To 12 Step -1
        If Len(Range("F" & lngMyRow)) = 0 And Len(Range("G" & lngMyRow)) = 0 Then
            Rows(lngMyRow).EntireRow.Delete
        End If
    Next lngMyRow
    
    With Application
        .Calculation = xlnCalcMethod
        .ScreenUpdating = True
    End With
    End Sub


    
Sub Unposted_Journals()
    ActiveSheet.Range("Jnl_Range").AutoFilter Field:=14, Criteria1:="="
End Sub
 
Upvote 0
tlc53 said:
Thanks. Everything's working fine except the buttons. They still seem to be running on the "E3" Sheet instead of the new "Journal" sheet.
I tried locating the macros on Sheet 12 (Journal tab),
Click to expand...

But if you are copying the "journal" sheet and the buttons are on the "journal" sheet, from the source the button code must be on the "journal" sheet.


Try this code in a new book only with the "journal" sheet and its buttons.


Code: 
Sub Test
    Application.DisplayAlerts = False
    Application.SheetsInNewWorkbook = 1
    Dim wb As Workbook
    Dim wName As String
    wName = Sheets("Journal").Range("K1").Value
    ThisWorkbook.Sheets("Journal").Copy
    Set wb = ActiveWorkbook
    wb.SaveAs wName, FileFormat:=xlOpenXMLWorkbookMacroEnabled
    wb.Close False
End Sub

The buttons must be in the new book. And they must run the macros.
This time they do not have to refer to another sheet, since there was only one sheet.
 
Upvote 0
I created a "TESTJNL" worksheet. This contained the "Journal/Sheet 12" tab only. The macro buttons stayed here.
I deleted all other module coding and placed your code (above) into a new module. I then ran your test code.
It saved a file "Journals YE 31 May 2019.xlsm". I then opened this file to test the buttons. The buttons were then referring to spreadsheet "TESTJNL" and not the active worksheet "Journals YE 31 May 2019.xlsm".

I hope I have followed instructions correctly..
 
Upvote 0
You can upload your test book to the cloud, with a single sheet, with buttons, macro and button macros.
 
Upvote 0
tlc53 said:
Thanks Dante. I'm obviously doing something strange..

https://www.dropbox.com/s/9wybwytrtahcxcq/TESTJNL.xlsm?dl=0
Click to expand...


Perfect! I ran the macro, created the new book, with the "Journal" sheet.
I closed the book, opened the new book.
There are the 4 buttons "delete", "clear", "view", "transfer". And I was able to run each of them with their own macro on the Sheet12(Journal) of the new book.

Maybe it's a problem in your office version.

Try following


Try the following approach. Copy the entire book, that includes all the sheets and all the macro.
Then open the new book and delete all the sheets except the "Journal" sheet.


Code: 
Sub Test2()
    Application.DisplayAlerts = False
    Application.SheetsInNewWorkbook = 1
    Dim wb As Workbook, sh As Worksheet
    Dim wName As String
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    wName = Sheets("Journal").Range("K1").Value
    
[COLOR=#0000ff]    ThisWorkbook.SaveCopyAs wName[/COLOR]
    
    Set wb = Workbooks.Open(wName)
    For Each sh In wb.Sheets
      If LCase(sh.Name) <> LCase("Journal") Then
        sh.Delete
      End If
    Next
    wb.Close True
End Sub
 
Upvote 0
You must log in or register to reply here.

Similar threads

H
  • Question Question
Copy Data where Source Workbook contains Name that is in destination sheet
Replies
4
Views
211
howard
H
H
  • Question Question
Macro to save sheet as a CVS
Replies
5
Views
604
Joe4
Joe4
D
  • Question Question
Save Copy of Current Workbook to Sharepoint from Excel
Replies
1
Views
656
NdNoviceHlp
NdNoviceHlp
B
  • Question Question
Copy and paste from one worksheet into a new workbook and save to a particular directory
Replies
3
Views
730
Joe4
Joe4
N
  • Question Question
Macro/VBA Create new folder and save workbook as
Replies
4
Views
549
NVRensburg
N

Forum statistics

Threads
1,224,823
Messages
6,181,170
Members
453,021
Latest member
Justyna P

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top