This code for saving worksheet is very slow

JumboCactuar

Well-known Member
Joined
Nov 16, 2016
Messages
788
Office Version
  1. 365
Platform
  1. Windows
Hi,
This code I have to add new workbook > copy data from active sheet to Sheet1 of new workbook then save runs slow.

Code:
Private Sub SaveSheet()
Dim WB1 As Workbook, WB2 As Workbook
Dim WS1 As Worksheet, WS2 As Worksheet

NUMBERA = Sheets("Main").TextBox1.Value
LR = Range("A65000").End(xlUp).Row

Application.ScreenUpdating = False

Set WB1 = ActiveWorkbook
Set WS1 = ActiveSheet
Set WB2 = Workbooks.Add
Set WS2 = WB2.Sheets("Sheet1")
DoEvents

MyDir = "C:\TEST\"

WS2.Range("A1:Z" & LR).Value2 = WS1.Range("A1:Z" & LR).Value2

WB2.SaveAs MyDir & NUMBERA & ".xlsx"
WB2.Close

Application.screenupdating = true

End Sub

Also even with screenupdating disabled I still see a blank excel window with "saving" prompt

Anyone know a better way to do this?

Any help appreciated
 
Last edited:

Excel Facts

When they said...
When they said you are going to "Excel at life", they meant you "will be doing Excel your whole life".
Remove the doevents line and add line to calculation

Code:
Private Sub SaveSheet()
  Dim WB1 As Workbook, WB2 As Workbook
  Dim WS1 As Worksheet, WS2 As Worksheet
  
  NUMBERA = Sheets("Main").TextBox1.Value
  lr = Range("A65000").End(xlUp).Row
  
  Application.ScreenUpdating = False
[COLOR=#0000ff]  Application.Calculation = xlCalculationManual[/COLOR]
  Set WB1 = ActiveWorkbook
  Set WS1 = ActiveSheet
  Set WB2 = Workbooks.Add
  Set WS2 = WB2.Sheets("Sheet1")
  MyDir = "C:\TEST\"
  WS2.Range("A1:Z" & lr).Value2 = WS1.Range("A1:Z" & lr).Value2
  WB2.SaveAs MyDir & NUMBERA & ".xlsx"
  WB2.Close False
  Application.ScreenUpdating = True
[COLOR=#0000ff]  Application.Calculation = xlCalculationAutomatic[/COLOR]
End Sub
 
Upvote 0

Forum statistics

Threads
1,223,099
Messages
6,170,107
Members
452,302
Latest member
TaMere

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