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

mummo

New Member
Joined
Apr 2, 2021
Messages
29
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?
 
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


View attachment 36288
Hi,

Okay so those sheets are actually from an older version and doesn't exist on the current version.

Here is the link to the workbook I am using. Hope the link works!
 
Upvote 0

Excel Facts

Format cells as currency
Select range and press Ctrl+Shift+4 to format cells as currency. (Shift 4 is the $ sign).
Hi,
Looking at your master workbook the Sheets in the RefersTo named ranges shown in BOLD

RefersToR1C1:="='BUDSJETT Standard Loan'!R72C12:R86C12"
RefersToR1C1:="='Standard Loans'!R10C4"

do not exist & are therefore, not being copied to your stand alone copy hence reason they do not work.

Wherever you have these sheets located, they need to be included as part of the copy process

Dave
 
Upvote 0
Hi,
Looking at your master workbook the Sheets in the RefersTo named ranges shown in BOLD

RefersToR1C1:="='BUDSJETT Standard Loan'!R72C12:R86C12"
RefersToR1C1:="='Standard Loans'!R10C4"

do not exist & are therefore, not being copied to your stand alone copy hence reason they do not work.

Wherever you have these sheets located, they need to be included as part of the copy process

Dave
They seem to be a leftover from previous version that are no longer needed.
I deleted them from namemanager and from the updatenamemanager-code so they are not in the new copy at all, but still the cell references are not working.

For example on top of every sheet is the "Application number" cell that should copy the data from "Checklist and decision" -sheet's cell H2. The new copy breaks this link and only copies the value. This happens with every cell that has a cell reference to another sheet.
 
Upvote 0
If your intention is to make a standalone copy of the master workbook then all references need to be within the new workbook i.e. not linked to any external sources.

Dave
 
Upvote 0
If your intention is to make a standalone copy of the master workbook then all references need to be within the new workbook i.e. not linked to any external sources.

Dave
Hi, yes that is what I tried to do. Sorry if I was unclear, english is not my first language. Is there a way to do that?
 
Upvote 0
Hi, yes that is what I tried to do. Sorry if I was unclear, english is not my first language. Is there a way to do that?

You will need to ensure that all relevant worksheets are copied to new workbook & any named ranges used in your formulas reference to correct sheets / Range(s)

Dave
 
Upvote 0
You will need to ensure that all relevant worksheets are copied to new workbook & any named ranges used in your formulas reference to correct sheets / Range(s)

Dave
I think I resolved this issue with find/replace!
The bad names and links would still stay on with this way, but I didn't get any error messages and cell references seemed to work. Below is the altered code that I used, just in case you are interested.

I appreciate your help very much and could not have done this with on my own!

VBA Code:
Sub SaveReplace()

Dim x           As Integer
    Dim FileName    As String, FilePath As String
    Dim NewWorkBook As Workbook, OldWorkBook As Workbook
   Dim sht As Worksheet
    Dim fnd As Variant
    Dim rplc As Variant
    
    fnd = "[Loan Calculation 1.3 viimeisin - Copy.xlsm]"
    rplc = ""
 
    Set OldWorkBook = ThisWorkbook
   
    With Application
        .ScreenUpdating = False: .DisplayAlerts = False
    End With
   
    On Error Resume Next
    With OldWorkBook.Sheets("CSG")
        FilePath = "C:\Users\Tomi\Desktop\" & .Range("B1").Value & " " & .Range("B2").Value
        FileName = .Range("B1").Value & " " & .Range("B2").Value & ".xlsx"
        'L:\CS\Tomi Miettinen\Testi\
    End With
   
    MkDir FilePath
    On Error GoTo -1
   
    On Error GoTo myerror
    FilePath = FilePath & "\"
   
    For x = 2 To OldWorkBook.Worksheets.Count
        With OldWorkBook.Worksheets(x)
            If Not NewWorkBook Is Nothing Then
                .Copy after:=NewWorkBook.Worksheets(NewWorkBook.Worksheets.Count)
            Else
                .Copy
                Set NewWorkBook = ActiveWorkbook
            End If
        End With
    Next x
    
    
    For Each sht In NewWorkBook.Worksheets
  sht.Cells.Replace what:=fnd, Replacement:=rplc, _
    LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, _
    SearchFormat:=False, ReplaceFormat:=False
Next sht
    
    NewWorkBook.SaveAs FilePath & FileName, 51
       
     
myerror:
   If Not NewWorkBook Is Nothing Then NewWorkBook.Close False
    With Application
        .ScreenUpdating = True: .DisplayAlerts = True
    End With
    If Err <> 0 Then MsgBox (Error(Err)), 48, "Error"


End Sub
 
Upvote 0
Glad you managed to resolve it & appreciate feedback

Dave
 
Upvote 0

Forum statistics

Threads
1,213,485
Messages
6,113,931
Members
448,533
Latest member
thietbibeboiwasaco

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