Frage

I have this code that's used for getting a file ready to save and saving, however it causes Excel to 'encounter an error' and close. I have pinned the error down to the .execute line.

Why does this cause the crash and is there a work around?

Sub Save_close()

    Dim Ws As Worksheet
    Dim Wb As Workbook

    Application.DisplayAlerts = False

    MsgBox "Do you want to Save a new copy", vbYesNo, "Save New"

    If vbYes Then

        Workbooks("A380 Master.xlsm").Sheets("OutPutSheet").Range("C:C", "F:F").Delete

    For Each Ws In ActiveWorkbook.Sheets
        If Not Ws.Name = "OutputSheet" Or Ws.Name = "Sheet1" Then
            Ws.Delete

        ElseIf Ws.Name = "OutputSheet" Or Ws.Name = "Sheet1" Then

        End If
    Next Ws

    With Application.FileDialog(msoFileDialogSaveAs)
        .Show
        .Execute
    End With

    ElseIf vbNo Then

        'Workbooks("A380 Master.xlsm").Sheets("OutPutSheet").Range("A1").Select
    End If

End Sub
War es hilfreich?

Lösung

To summarize the comments above, a solution would be :

Sub Save_close()

Dim Ws As Worksheet
Dim Wb As Workbook
Dim i as Long

Application.DisplayAlerts = False

Set Wb = Workbooks("A380 Master.xlsm")

If (MsgBox("Do you want to Save a new copy", vbYesNo, "Save New")) = vbYes Then

    Wb.Sheets("OutPutSheet").Range("C:C", "F:F").Delete

    For i = Wb.Sheets.Count to 1 step -1
        Set Ws = Wb.Sheets(i)
        ' Delete all except "OutputSheet" and "Sheet1"
        If Not (Ws.Name = "OutputSheet" Or Ws.Name = "Sheet1") Then
            Ws.Delete
    '    ElseIf Ws.Name = "OutputSheet" Or Ws.Name = "Sheet1" Then

        End If
    Next i

    Wb.SaveAs 

Else

    'Workbooks("A380 Master.xlsm").Sheets("OutPutSheet").Range("A1").Select
End If

End Sub
Lizenziert unter: CC-BY-SA mit Zuschreibung
Nicht verbunden mit StackOverflow
scroll top