Automatically Copying Data To A New Workbook When Closing A Workbook

Tmini

New Member
Joined
Mar 22, 2014
Messages
44
Office Version
  1. 365
Platform
  1. Windows
Hi
I currently have a VBA macro where I click on a button and it will copy unformatted data to a new workbook and I have to manually save that new workbook to a specified folder. What I would like to do is instead of manually having to do this before I exit the workbook I would like for it to automatically do this once I click on the exit button. I have tried doing this a few different ways but whatever I do doesn't seem to work. I have a folder named small files that I would like it to be saved in which resides in the same folder I currently have the macro enabled workbooks that I am copying the data from. The following is the code which executes once I click on the button. Rather than this being a manual process I would like it to be automatic as then there will be less chance of me forgetting to copy the data over to the new workbooks.
The entire reason I am doing this is that the workbook I am working in is quite a large file due to formatting, formulas etc which is required to work out the information I need - it comes to approximately 8 megabytes. Being such a large file it takes a few seconds to open and even longer to save and exit. I have another workbook which goes through all of the excel files gathers all of the information I need and consolidates it all into one single file. Going through hundreds of files that take several seconds to open copy the data and close takes a very long time and creating these unformatted smaller files reduces that amount of time by approximately 80% reducing what could take hours down to minutes for much of my work.
Is there a command I can add to my below code that will automatically execute my code below and save it to my folder called "Small Files" once I click the exit button? I will like it to use the same name that the original file is called, if that is possible, and to be able to check if it is already in the folder and ask for it to be overwritten if I need to go back and make any changes to the original file.
I hope I have made sense and that I can get some help on this. Everything I have tried just seems to generate a new file without any data in it

VBA Code:
Option Explicit
Sub RunAllMacros()

    copySheets
    Hidesheet
  
End Sub
Sub copySheets()
    Dim wkb As Excel.Workbook
    Dim newWkb As Excel.Workbook
    Dim wks As Excel.Worksheet
    Dim newWks As Excel.Worksheet
    Dim sheets As Variant
    Dim varName As Variant
    Dim screenUpdateState As String
    Dim statusBarState As String
    Dim eventsState As String
    '------------------------------------------------------------
    screenUpdateState = Application.ScreenUpdating
    statusBarState = Application.DisplayStatusBar
    eventsState = Application.EnableEvents

    'turn off some Excel functionality for faster performance
    Application.ScreenUpdating = False
    Application.DisplayStatusBar = False
    Application.EnableEvents = False
      
        'Unhide worksheets
    Worksheets("Total Quantities").Visible = xlSheetVisible
    Worksheets("VE Total Quantities").Visible = xlSheetVisible
  
    
    

    'Define the names of worksheets to be copied.
    sheets = VBA.Array("Total Quantities", "VE Total Quantities", "Builder Costings", "Panelling Information")
    

    'Create reference to the current Excel workbook and to the destination workbook.
    Set wkb = Excel.ThisWorkbook
    Set newWkb = Excel.Workbooks.Add
    


    For Each varName In sheets

        'Clear reference to the [wks] variable.
        Set wks = Nothing

        'Check if there is a worksheet with such name.
        On Error Resume Next
        Set wks = wkb.Worksheets(VBA.CStr(varName))
        On Error GoTo 0


        'If worksheet with such name is not found, those instructions are skipped.
        If Not wks Is Nothing Then

            'Copy this worksheet to a new workbook.
            Call wks.Copy(newWkb.Worksheets(1))

            'Get the reference to the copy of this worksheet and paste
            'all its content as values.
            Set newWks = newWkb.Worksheets(wks.Name)
            With newWks
                ActiveSheet.Unprotect Password:="password"
                Call .Cells.Copy
                Call .Range("A1").PasteSpecial(Paste:=xlValues)
            End With
        End If


    Next varName
    
                Worksheets("Total Quantities").Range("A1:M295").ClearFormats
                Worksheets("VE Total Quantities").Range("A1:M295").ClearFormats
                Worksheets("Panelling Information").Range("A1:AA11").ClearFormats
                


End Sub
Sub Hidesheet()
    Excel.ThisWorkbook.Worksheets("Total Quantities").Visible = xlSheetHidden
    Excel.ThisWorkbook.Worksheets("VE Total Quantities").Visible = xlSheetHidden
End Sub
 

Excel Facts

Can a formula spear through sheets?
Use =SUM(January:December!E7) to sum E7 on all of the sheets from January through December
Paste the folowing in the THIS WORKBOOK module.

Where indicated, enter the name/s of the macro/s you want run before the workbook closes.

VBA Code:
Private Sub Workbook_BeforeClose(Cancel As Boolean)

 'Your Code here.

End Sub
 
Upvote 0
Paste the folowing in the THIS WORKBOOK module.

Where indicated, enter the name/s of the macro/s you want run before the workbook closes.

VBA Code:
Private Sub Workbook_BeforeClose(Cancel As Boolean)

 'Your Code here.

End Sub
Thanks for that. That sort of works but when the resulting file comes up it has a problem with the menu at the top where it doesn't show up and I have to close the initial workbook down and minimise and maximise the resulting workbook for the menu to pop up so I can save it. I have attached an image of the issue. I also would like the file to automatically save in the folder called small files with the same filename as the filename of the initial workbook. Is this possible?
Thanks again I appreciate your help
 

Attachments

  • Screenshot 2024-08-01 070923.jpg
    Screenshot 2024-08-01 070923.jpg
    93.7 KB · Views: 3
Upvote 0
That sort of works but when the resulting file comes up it has a problem with the menu at the top where it doesn't show up and I have to close the initial workbook down and minimise and maximise the resulting workbook for the menu to pop up so I can save it.
I'm not sure I fully understand what you are referring to.


Regarding saving the workbook, add the following code to the bottom of your existing code just above the END SUB:

VBA Code:
Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Dim FName           As String
    Dim FPath           As String
      
    FPath = "C:\Users\My\Desktop"       '<---------------------------------------- Change SAVE DIRECTORY as required
  
    FName = "SaveAsFilename.xlsb"     '<----------------------------------------- Change file name as required
    ThisWorkbook.SaveAs Filename:=FPath & "\" & FName
  
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
 
Upvote 0
The ribbon menu at the top disappears on the newly created workbook. My guess it's a bug with excel but that won't be a problem once I can solve the below issue

I apologise I didn't explain what myself properly. I want to be able to automatically save the newly created workbook with the same filename as the the workbook I am working from. The code you suggested is saving my current workbook that the data is being copied from and I don't need that. My guess is that I need to alter the following line of code so that the new file is saved in the correct directory -

VBA Code:
Set newWkb = Excel.Workbooks.Add

The directory where the new files will be saved in will be called small files and be in the same folder as the originating workbook. I hope this is making sense
 
Upvote 0

Forum statistics

Threads
1,221,310
Messages
6,159,176
Members
451,543
Latest member
cesymcox

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