Copy-save sheets

CLE81

New Member
Joined
Oct 23, 2020
Messages
19
Office Version
  1. 2019
  2. 2016
Platform
  1. Windows
Hello,

I ve made an VBA script to copy Excel worksheets seperately as .CSV documents.

When I run this script the screen is flashing when it copy-save each sheet. I think the reason is because I have used de ActivateSheet and .Select command.

I there a possibility to run an VBA script copy-save sheets without flashing the screen?

Script I used:

VBA Code:
Private Sub UserForm_Activate()

'--- Declare variables ----
    Dim I As Integer
    Dim HMI_name As String
        
'Instellen variabelen
    aw_name = ActiveWorkbook.Name
    sh_Voorblad = "Voorblad"
    sh_DiscreteAlarms = "#Masterdata"
    HMI_Config = "HMI_Config"
            
    Projectnr = Workbooks(aw_name).Sheets(sh_Voorblad).Cells(6, 2).Value
    Bestandsnaam = Workbooks(aw_name).Sheets(sh_Voorblad).Cells(7, 2).Value
    
    AmountLanguages = Workbooks(aw_name).Sheets(HMI_Config).Cells(Rows.Count, 1).End(xlUp).Row
    
'Samenstellen opslaglocatie voor het bestand
    sPadnaam = Workbooks(aw_name).Sheets(sh_Voorblad).Cells(4, 2).Value

'Controle of padnaam correct is ingevuld
    If Not (Right(sPadnaam, 1)) = "\" Then
        MsgBox "De padnaam wordt niet gevonden!" & Chr(13) & Chr(13) & _
                "Plaats achter padnaam een: ( \ ) !", vbOKOnly, "Fout"
        Exit Sub
    End If
    
'Kopieren en opslaan Import file [Masterdata]
    For K = 2 To AmountLanguages
    
        '-------- Progress bar Language -------------------------------
        Me.LabelBar1.Caption = Round(((K - 1) / (AmountLanguages - 1)) * 100) & " %"
        Me.LabelSubInfo1.Caption = K - 1 & "/ " & (AmountLanguages - 1)
        Me.LabelProgress1.Width = 200 * (K - 1) / (AmountLanguages - 1)
        '--------------------------------------------------------------
    
        'Set language
        Language = ActiveWorkbook.Sheets(HMI_Config).Cells(K, 1)
        
        sBestandsnaam = Projectnr & "_" & Bestandsnaam & "_" & Format(Date, "ddmmyyyy") & "_" & Format(Time, "HHMM") & "_" & Language & ".xlsx"
    
        Worksheets(sh_DiscreteAlarms & "_" & Language).Activate 'Open werkblad welke wordt opgeslagen
        ActiveSheet.Copy                                        'Kopieer werkblad
        ActiveSheet.Name = "DiscreteAlarms"                     'Rename werkblad
        ActiveSheet.SaveAs Filename:=sPadnaam & sBestandsnaam   'Opslaan werkblad
        ActiveWorkbook.Close                                    'Sluit opgeslagen bestand
    
'Kopieren en opslaan Import file [HMI's]
        Final_HMI = Sheets(HMI_Config).Cells(1, Sheets(HMI_Config).Columns.Count).End(xlToLeft).Column
            
        For I = 2 To Final_HMI
            HMI_name = "#" & ActiveWorkbook.Sheets(HMI_Config).Cells(1, I) & "_" & Language
            sBestandsnaam = Projectnr & "_" & Bestandsnaam & "_" & Format(Date, "ddmmyyyy") & "_" & Format(Time, "HHMM") & "_" & HMI_name & ".xlsx"
            
            '----- Progress bar - Rows ------------------------------------
            Me.LabelBar2.Caption = Round((I / Final_HMI) * 100) & " %"
            Me.LabelSubInfo2.Caption = I & "/ " & Final_HMI
            Me.LabelProgress2.Width = 200 * I / Final_HMI
            '--------------------------------------------------------------
            
            If (HMI_name <> "") And (HMI_name <> "#") Then
                Worksheets(HMI_name).Activate                           'Open werkblad welke wordt opgeslagen
                ActiveSheet.Copy                                        'Kopieer werkblad
                ActiveSheet.Name = "DiscreteAlarms"                     'Rename werkblad
                ActiveSheet.SaveAs Filename:=sPadnaam & sBestandsnaam   'Opslaan werkblad
                ActiveWorkbook.Close                                    'Sluit opgeslagen bestand
            End If
        Next I
    Next K
    
    '------ Finalize ----------------------------------------------
    ActiveWorkbook.Sheets("Voorblad").Activate
    Application.ScreenUpdating = True
    
    Unload Me
End Sub
 

Some videos you may like

Excel Facts

Save Often
If you start asking yourself if now is a good time to save your Excel workbook, the answer is Yes

rollis13

Active Member
Joined
Jul 30, 2012
Messages
367
Office Version
  1. 2016
Platform
  1. Windows
Not sure if it will help (don't think so) but at the end of your macro I found a:
Application.ScreenUpdating = True
without its correspondent at the beginning:
Application.ScreenUpdating = False
 

CLE81

New Member
Joined
Oct 23, 2020
Messages
19
Office Version
  1. 2019
  2. 2016
Platform
  1. Windows
I 've already tried it but it didn't solve the problem. :(
 

rollis13

Active Member
Joined
Jul 30, 2012
Messages
367
Office Version
  1. 2016
Platform
  1. Windows
I understand, so, not very sure but I think that what you are asking can't be done. Hope someone else has a solution.
 

Watch MrExcel Video

Forum statistics

Threads
1,122,995
Messages
5,599,256
Members
414,299
Latest member
thenewworld

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