VBA Windows 10 code crashes excel when executing. Works when stepping through. Runs on Windows 7 fine.


New Member
Aug 21, 2014
Hi all,

I have the code below that loops through data and saves off many workbooks based on criteria given in the code. Fairly simple process...just copying/pasting data/sheets and saving workbooks. The code crashes excel (sometimes on the first loop or sometimes after a few workbooks have been saved). The code works on Windows 10 if you step through the code. I also have a remote desktop Windows 7 machine that I've tested the code on and works on execution mode as well as stepping through. Any thoughts to what is causing the code to crash? I have other modules on my Windows 10 machine that run fine, so it is something about the code below!

VBA Code:
Public contact As String
Public subject As String
Public mypath As String

Sub ValuePaster()

'  Workbooks(filetemplatename).Sheets("Summary").Activate

Dim CostCenter As String
    Dim fileTemplatepath As String
        Dim filetemplatename As String
            Dim filecostcenter As String
                Dim group As String
                    Dim FileName As String
                        Dim division As String
                            Dim owner As String
Dim costcenters As String
    Dim wb1 As String
        Dim xsheets As Integer
            Dim xindex As Integer
                Dim i As Long
                    Dim ws As Worksheet
                        Dim lr As Long

Dim pt As PivotTable

With Application
    .ScreenUpdating = False
    .EnableEvents = False
    .DisplayAlerts = False
End With

filetemplatename = ThisWorkbook.Name
fileTemplatepath = ThisWorkbook.FullName
Set counter = Range("counter")
Range("counter").Value = Range("startcounter") 'cell f2


'Start Loop Here
Do Until counter = Range("endcounter") 'cell g2

group = Range("group")
owner = Range("owner")
FileName = Range("filename")
division = Range("division")

Set counter = Range("counter")
startcounter = Range("startcounter")
endcounter = Range("endcounter")
costcenters = Range("costcenters")

mypath = Range("mypath")
contact = Range("contact")
subject = Range("subject")

'IF Group = YES then ' this is if the management report will have multiple cost centers
If group = "YES" Then

    Set wbnew = ActiveWorkbook
        wbnew.SaveAs ThisWorkbook.Path & "\" & FileName
        Application.Wait (Now + TimeValue("0:00:10"))
 wb1 = ActiveWorkbook.Name

'Loop by using x as the index number to make x number copies.
'Replace "Sheet1" with the name of the sheet to be copied.

xsheets = costcenters
        For i = 1 To xsheets - 1
            Sheets("Summary").Copy before:=Sheets(1)
'Now rename each sheet to a specific cost center
    xinteger = Sheets("summary").Index
        For i = 1 To xinteger
'           activeworkbok.Sheets(i).Activate
 '           activeworkbok.Worksheets(i).Calculate
                If ActiveSheet.Name = "Consolidated" Then Exit For
                Range("e3") = Sheets("cc's").Range("c5")
                         ActiveSheet.Name = Range("E3")
                             Workbooks(wb1).Sheets("cc's").Range("counter").Value = Workbooks(wb1).Sheets("cc's").Range("counter").Value + 1
' Workbooks(filetemplatename).Sheets("cc's").Range("counter").Value = counter + xsheets

'Move the sheets between first:last sheets
            i = 1
                    If ActiveSheet.Name = "Consolidated" Then Exit Do
                        Worksheets(i).Move before:=Worksheets("last")

'ending the If statement above "if group = "yes" then goto Group begin
GoTo GroupBegin

End If

'If "No" then the macro will START HERE

Set wbnew = ActiveWorkbook
wbnew.SaveAs ThisWorkbook.Path & "\" & FileName

'Group Begin
GroupBegin: 'If the current workbook is a grouping, start macro again here

'wbnew.SaveAs "FY18 Budget Summary " & CostCenter, FileFormat:=xlOpenXMLWorkbook

If Sheets.Count <= 8 Then 'If the sheet count is equal to or less than 9 then we would delete consolidated/first/last as it would be a single cost center template
    filecostcenter = ActiveWorkbook.Name
            Workbooks(filecostcenter).Sheets("Summary").Name = Range("e3")
                   Sheets(Array("consolidated", "first", "last")).Delete
                        End If

filecostcenter = ActiveWorkbook.Name




For Each Worksheet In Workbooks(filecostcenter).Worksheets ' Selects visible sheets only and pastes values only
        If ActiveSheet.Name <> "CC's" Then
        ActiveSheet.UsedRange.Value = ActiveSheet.UsedRange.Value
        End If
            Next Worksheet

        ''deleting the code below and trying a more simpler method above
'        Do
'          a = 1
'         If Worksheet.Visible = False Then Exit Do
'             Worksheet.Activate
'             If ActiveSheet.Name <> "CC's" Then
'            ' On Error Resume Next
'                 ActiveSheet.UsedRange.Value = ActiveSheet.UsedRange.Value
'                    End If
'                     a = a + 1
'                         Loop Until a = 2
'                            Next Worksheet
For Each Sheet In ActiveWorkbook.Sheets ' Deletes all non-visible sheets
    If Sheet.Visible = False Then Sheet.Delete
     Next Sheet

'Z = 1
'    ActiveWorkbook.Sheets(Z).Activate
'      Z = Z + 1
'         Loop Until ActiveSheet.Name = "NOT USED" _
'             Or ActiveSheet.Index = Sheets.Count

ActiveWorkbook.Sheets("NOT USED").Activate

    If ActiveSheet.Index = Sheets.Count Then Exit Do
     If ActiveSheet.Name = "NOT USED" Then y = ActiveSheet.Index
       For Each Sheet In ActiveWorkbook.Sheets
         If Sheet.Index >= y Then Sheet.Delete
             Next Sheet

'If ActiveSheet.Name = "NOT USED" Then ActiveSheet.Delete

'Application.DisplayAlerts = True ' Turns back on the delete y/n confirmation dialog box

Application.CutCopyMode = False ' Deactivates cut/copy function so it's not waiting to paste copied data

For Each Worksheet In ActiveWorkbook.Worksheets ' Selects cell A1 on all sheets to deactivate highlighting
    Next Worksheet


        '   ActiveWindow.DisplayOutline = False 'Hides all outline marks
'            ActiveWindow.View = xlNormalView
'            ActiveWindow.FreezePanes = False

   ' Next Worksheet
'ActiveWindow.WindowState = xlMaximized ' Maximizes the active window

'For Each Button In ActiveSheet.Buttons ' Deletes all buttons on the active sheet
'    Button.Delete
'    Next Button

'The following deletes the first sheet in the model if it is called "InputVariables".
'The sheets by that name in our current models are of no use to clients, so the macro
'deletes them since the intention of the model is to produce a document for client
'review.  If the first sheet is named something other than "InputVariables",it is not
'deleted - this is so the macro can be applied to other models in which the first sheet
'should not be deleted.
   ' Application.DisplayAlerts = False 'Turns off the page deletion dialog box
'    Worksheets(1).Select
'    If ActiveSheet.Name = "InputVariables" Then ActiveSheet.Delete
'    Worksheets(1).Select
'    Range("A1").Select
  '  Application.DisplayAlerts = True 'Turns back on the page deletion dialog box

'Range("A1").Select ' Select the upper left cell of the inputs sheet to give the macro an orderly end.

Application.CutCopyMode = False

On Error Resume Next
Sheets(Array("first", "last")).Delete


'Call groupme
Call Edit

If Sheets.Count = 2 Then
End If

Application.Goto ActiveCell, True

Application.DisplayAlerts = False

On Error GoTo SaveAgain
Application.Wait (Now + TimeValue("0:00:15"))

filecostcenter = vbNullString

'''''''''''''''''Call email


Set counter = Range("counter")
startcounter = Range("startcounter")
endcounter = Range("endcounter")

If xsheets = 0 Then
     Range("Counter").Value = counter + 1

            Range("Counter").Value = counter + xsheets

End If

xsheets = 0

Loop 'Ends counter loop


With Application
    .ScreenUpdating = True
    .EnableEvents = True
    .DisplayAlerts = True
End With

Dim Msg6, Style6, Title6, Response6
    Msg6 = "Pasting complete."    ' Define message.
    Style6 = vbOKOnly ' Define buttons.
    Title6 = "V A L U E  P A S T E R"
    Response6 = MsgBox(Msg6, Style6, Title6)

LineLabelEnd: ' Inserted as an alternative target for the previous GoTo function

End Sub

Some videos you may like

Excel Facts

How to change case of text in Excel?
Use =UPPER() for upper case, =LOWER() for lower case, and =PROPER() for proper case. PROPER won't capitalize second c in Mccartney


Well-known Member
Dec 3, 2018
Office Version
  1. 2007
  1. Windows
On which line of the macro is the execution stopped?
What does the error message say?

Watch MrExcel Video

Forum statistics

Latest member

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