VBA to save a copy with cell value name and chosen sheets

mummo

New Member
Joined
Apr 2, 2021
Messages
24
Office Version
  1. 365
Platform
  1. Windows
Hello!
I am pretty new to VBA an this is my first post here.
My problem is that I am trying to make a save button in file that has multiple sheets. I need it to save a copy of the open workbook in xlsx-format, with a name from A1 and remove one sheet from the copy. I have it working, but it flashes the excel on the screen before saving. It should save it in the background, not open it and keep the current workbook open without saving anything to the active workbook.
This is the current code:

Sub SaveOma()

Dim FileName As String
Dim Path As String
Dim NewWorkBook As Workbook
Dim OldWorkBook As Workbook
Set NewWorkBook = Workbooks.Add
Set OldWorkBook = ThisWorkbook
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Path = "C:\Users\Tomi\Desktop\"
FileName = OldWorkBook.Sheets("Checklist and decision").Range("A1").Value & ".xlsx"

Dim x As Integer

For x = 2 To OldWorkBook.Worksheets.Count
OldWorkBook.Worksheets(x).Copy after:=NewWorkBook.Worksheets(NewWorkBook.Worksheets.Count)
Next x

NewWorkBook.Worksheets(1).Delete

NewWorkBook.SaveAs Path & FileName
NewWorkBook.Close

Application.ScreenUpdating = True
Application.DisplayAlerts = True

End Sub


Is there anything to add or improve so it would run more smoothly?
 

mummo

New Member
Joined
Apr 2, 2021
Messages
24
Office Version
  1. 365
Platform
  1. Windows
Sounds like progress

Next step

from your master file turn the macro recorder on & then open the name manager.
Select in turn from the list, only the names that are required in the copied workbooks.
With each selection, press the Edit Button & when the Edit Name dialog appears, just press the OK button.

When all done, close the name manager & turn macro recorder off.
copy the recorded code & post it here. You can then delete the recorded code from your file.

Dave
Did it and got this:

VBA Code:
Sub NameManager()
'
' NameManager Macro
'

'
    With ActiveWorkbook.Names("Antallbarn")
        .Name = "Antallbarn"
        .RefersToR1C1 = _
        "=OFFSET('C:\Users\Username\AppData\Local\Microsoft\Windows\INetCache\Content.Outlook\D49I1HVK\[CalcTemplateSamtligaKalkyler_NO_macro v22 23 June 20142121_V2 Update 1709171-update 230720191 (003).xlsm]BUDSJETT Standard Loan'!R72C12,,,COUNTA('C:\Users\robin.mattsson\AppData\Local\Microsoft\Windows\INetCache\Content.Outlook\D49I1HVK\[CalcTemplateSamtligaKalkyler_" & _
        "NO_macro v22 23 June 20142121_V2 Update 1709171-update 230720191 (003).xlsm]BUDSJETT Standard Loan'!R72C12:R86C12))" & _
        ""
        .Comment = ""
    End With
    With ActiveWorkbook.Names("Bonus_loan_margin2")
        .Name = "Bonus_loan_margin2"
        .RefersToR1C1 = _
        "='C:\Users\username\AppData\Local\Microsoft\Windows\INetCache\Content.Outlook\D49I1HVK\[CalcTemplateSamtligaKalkyler_NO_macro v22 23 June 20142121_V2 Update 1709171-update 230720191 (003).xlsm]Standard Loans'!R10C4"
        .Comment = ""
    End With
    With ActiveWorkbook.Names("LoanNumber")
        .Name = "LoanNumber"
        .RefersToR1C1 = "=Economy!R2C6"
        .Comment = ""
    End With
    With ActiveWorkbook.Worksheets("Economy").Names("Print_Area")
        .Name = "Print_Area"
        .RefersToR1C1 = "=Economy!R1C1:R107C33"
        .Comment = ""
    End With
End Sub
 
Last edited by a moderator:

Excel Facts

Remove leading & trailing spaces
Save as CSV to remove all leading and trailing spaces. It is faster than using TRIM().

dmt32

Well-known Member
Joined
Jul 3, 2012
Messages
6,515
Office Version
  1. 2019
Platform
  1. Windows
ok thanks - bit short on time today but will get back to you asap

Dave
 

dmt32

Well-known Member
Joined
Jul 3, 2012
Messages
6,515
Office Version
  1. 2019
Platform
  1. Windows
Hi
Place this code in same module as the Break Links / DeleteBadNames codes.

VBA Code:
Sub UpdateNameManager(ByVal wb As Object)

    With wb
        .Names.Add Name:="Antallbarn", RefersToR1C1:="='BUDSJETT Standard Loan'!R72C12:R86C12"
        .Names.Add Name:="Bonus_loan_margin2", RefersToR1C1:="='Standard Loans'!R10C4"
        .Names.Add Name:="LoanNumber", RefersToR1C1:="=Economy!R2C6"
       
        .Worksheets("Economy").PageSetup.PrintArea = "$A$1:$AG$107"
    End With
   
End Sub

Then before the SaveAs line of code you need these three lines of code

Rich (BB code):
   DeleteBadNames NewWorkBook
   BreakAllLinks NewWorkBook
  UpdateNameManager NewWorkBook

    NewWorkBook.SaveAs FilePath & FileName, 51

Try this & see if resolves your issue

Dave
 

mummo

New Member
Joined
Apr 2, 2021
Messages
24
Office Version
  1. 365
Platform
  1. Windows
Hi
Place this code in same module as the Break Links / DeleteBadNames codes.

VBA Code:
Sub UpdateNameManager(ByVal wb As Object)

    With wb
        .Names.Add Name:="Antallbarn", RefersToR1C1:="='BUDSJETT Standard Loan'!R72C12:R86C12"
        .Names.Add Name:="Bonus_loan_margin2", RefersToR1C1:="='Standard Loans'!R10C4"
        .Names.Add Name:="LoanNumber", RefersToR1C1:="=Economy!R2C6"
      
        .Worksheets("Economy").PageSetup.PrintArea = "$A$1:$AG$107"
    End With
  
End Sub

Then before the SaveAs line of code you need these three lines of code

Rich (BB code):
   DeleteBadNames NewWorkBook
   BreakAllLinks NewWorkBook
  UpdateNameManager NewWorkBook

    NewWorkBook.SaveAs FilePath & FileName, 51

Try this & see if resolves your issue

Dave
Hi,

Still seems to do the same thing. The values go to the right places in the copy and I get no error-messages, but if someone would need to continue the calculations then it won't update the new info to all the right cells.
 

dmt32

Well-known Member
Joined
Jul 3, 2012
Messages
6,515
Office Version
  1. 2019
Platform
  1. Windows

ADVERTISEMENT

Hi,

Still seems to do the same thing. The values go to the right places in the copy and I get no error-messages, but if someone would need to continue the calculations then it won't update the new info to all the right cells.

In the copy workbook, if you click on the RefersTo in the Name Manager for each named range , are you taken to to correct ranges?

Dave
 

mummo

New Member
Joined
Apr 2, 2021
Messages
24
Office Version
  1. 365
Platform
  1. Windows
In the copy workbook, if you click on the RefersTo in the Name Manager for each named range , are you taken to to correct ranges?

Dave
While clicking the refers named "Antallbarn" and "Bonus_loan_margin2" It just takes me to the first sheet and doesn't choose any cell or range. Seems like they might be named ranges from previous versions.
 

dmt32

Well-known Member
Joined
Jul 3, 2012
Messages
6,515
Office Version
  1. 2019
Platform
  1. Windows

ADVERTISEMENT

While clicking the refers named "Antallbarn" and "Bonus_loan_margin2" It just takes me to the first sheet and doesn't choose any cell or range. Seems like they might be named ranges from previous versions.

curious - works ok for me

From the copy workbook, can you perform the same exercise as per #post 20 with marco recorder to produce code for named ranges & then post result back here?

Dave
 

mummo

New Member
Joined
Apr 2, 2021
Messages
24
Office Version
  1. 365
Platform
  1. Windows
curious - works ok for me

From the copy workbook, can you perform the same exercise as per #post 20 with marco recorder to produce code for named ranges & then post result back here?

Dave
This is what I got from the copy workbook:

VBA Code:
Sub Macro1()
'
' Macro1 Macro
'

'
    With ActiveWorkbook.Names("Antallbarn")
        .Name = "Antallbarn"
        .RefersToR1C1 = "='BUDSJETT Standard Loan'!R72C12:R86C12"
        .Comment = ""
    End With
    With ActiveWorkbook.Names("Bonus_loan_margin2")
        .Name = "Bonus_loan_margin2"
        .RefersToR1C1 = "='Standard Loans'!R10C4"
        .Comment = ""
    End With
    With ActiveWorkbook.Names("LoanNumber")
        .Name = "LoanNumber"
        .RefersToR1C1 = "=Economy!R2C6"
        .Comment = ""
    End With
    With ActiveWorkbook.Worksheets("Economy").Names("Print_Area")
        .Name = "Print_Area"
        .RefersToR1C1 = "=Economy!R1C1:R107C33"
        .Comment = ""
    End With
End Sub
 

dmt32

Well-known Member
Joined
Jul 3, 2012
Messages
6,515
Office Version
  1. 2019
Platform
  1. Windows
ok thanks - will have to get back to you in morning

Dave
 

dmt32

Well-known Member
Joined
Jul 3, 2012
Messages
6,515
Office Version
  1. 2019
Platform
  1. Windows
While clicking the refers named "Antallbarn" and "Bonus_loan_margin2" It just takes me to the first sheet and doesn't choose any cell or range. Seems like they might be named ranges from previous versions.

Hi,
carried out several tests & as can see from screen shot, selecting the RefersTo in the name manager takes me to the specified sheet & selects the range (as shown with marching ants)

At moment, not sure what else to suggest but If you are able, place copy of your main workbook with dummy data in a file sharing site like dropbox & provide a link to it here may help to understand what else may be occurring.

Dave


1617953058618.png
 

Watch MrExcel Video

Forum statistics

Threads
1,129,685
Messages
5,637,809
Members
416,983
Latest member
LessThanAverageUser

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
Top