This code for saving worksheet is very slow

JumboCactuar

Well-known Member
Joined
Nov 16, 2016
Messages
609
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:

DanteAmor

Well-known Member
Joined
Dec 3, 2018
Messages
7,708
Office Version
2007
Platform
Windows
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
 

Forum statistics

Threads
1,077,774
Messages
5,336,169
Members
399,068
Latest member
arfields

Some videos you may like

This Week's Hot Topics

Top