VBA causes excel to crash

[Doedtman]

Hello!
If anyone can help me out with suggestions, I would appreciate it. The coding I have below will run fine if I step through it, but if I run the macro it runs part way and crashes excel. It's been modified several times, but what I'm trying to do is copy specific excel tabs and save them as individual files (values and formats only). I ended up putting the macro in a separate file and opening both files to run the code. Any suggestions?

Sub SaveAsExcelFile()
Dim Filename As String
Dim Filepath As String
Dim file As String
Dim wb As ThisWorkbook
Dim wb1 As Workbook
Dim wb2 As Workbook
Dim intWS As Integer
Dim ws As String
Dim a As Integer


Set wb1 = ActiveWorkbook


Application.DisplayAlerts = False
Application.ScreenUpdating = False


Filepath = wb1.Sheets("Data").Range("E1").Value
file = wb1.FullName
wb1.Save
Application.StatusBar = "The macro is currently running..."
   Do While wb1.Connections.Count > 0 'tried removing connections to speed up macro
      wb1.Connections.Item(wb1.Connections.Count).Delete
   Loop
Application.StatusBar = "The macro is currently running...values"
wb1.Sheets("Data").Activate
Application.Calculation = xlManual 

'removes formulas in entire workbook and then closes later without saving
For Each Worksheet In wb1.Worksheets 
    Worksheet.Cells.Copy
    Worksheet.Cells.PasteSpecial xlPasteValues
    Next Worksheet
    
intWS = Application.CountA(Columns("A:A")) 'list of sheets to save as individual files
a = 1
Application.StatusBar = "The macro is currently running...create files"
Do Until a > intWS
On Error Resume Next
ws = wb1.Sheets("Data").Range("A" & a).Value
    wb1.Sheets(ws).Activate
    wb1.Sheets(ws).Copy
    Set wb2 = ActiveWorkbook
    wb2.SaveAs Filepath & ws: wb2.Close False


a = a + 1
Loop
Application.StatusBar = "The macro is currently running...saving and reopening"
wb1.Close False
Application.Workbooks.Open (file)


Application.StatusBar = "The macro is currently running...done"
Application.StatusBar = False
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

 

[JackDanIce]

Do you know what line the macro crashes on when you run it normally?

Try replacing all of your code with below

Sub SaveFile()
    
    Dim i               As Long
    Dim x               As Long
    Dim y               As Long
        
    With Application
        .DisplayAlerts = False
        .ScreenUpdating = False
        .Calculation = xlManual
    End With
    
    With ActiveWorkbook
        .Save
        
        Application.StatusBar = "Macro running"
        For i = 1 To .Connections.Count
            .Connections.Item(i).Delete
        Next i
        
        Application.StatusBar = "Macro running (Values)"
        For i = 1 To .sheets.Count
            With .sheets(i)
                x = LastRow(.sheets(i))
                y = LastCol(.sheets(i))
                .Cells(1, 1).Resize(x, y).Value = .Cells(1, 1).Resize(x, y).Value
            End With
        Next i
        
        Application.StatusBar = "Macro running (Create Files)"
        With .sheets("data")
            x = LastRow(.sheets("data"))
            For i = 1 To x
                If Len(.Cells(i, 1).Value) Then
                    On Error Resume Next
                    ActiveWorkbook.sheets(.Cells(i, 1).Value).Copy
                    ActiveWorkbook.SaveAs .Cells(1, 5).Value & .Cells(i, 1).Value
                    ActiveWorkbook.Close
                    On Error GoTo 0
                End If
            Next i
        End With
        
        Application.StatusBar = "Macro running...(Save)"
        .Save
        
    End With
    
    Application.StatusBar = "Macro running...(Done)"
    With Application
        .StatusBar = False
        .DisplayAlerts = True
        .Calculation = xlCalculationAutomatic
        .ScreenUpdating = True
    End With
        
End Sub


Function LastRow(ByRef wks As Worksheet) As Long
    
    With wks
        LastRow = .Cells.Find("*", .Cells(1, 1), xlFormulas, xlPart, xlRows, xlPrevious, True).Row
    End With
    
End Function

Function LastCol(ByRef wks As Worksheet) As Long

    With wks
        LastCol = .Cells.Find("*", .Cells(1, 1), xlFormulas, xlPart, xlColumns, xlPrevious, True).Column
    End With
    
End Function