excel saving to xlstart

[rikvny02]

Can someone help. Why are my sheets saving to the XLstart folder instead of the folder path with the original file. Thanks in advance

Private Sub CreateWorkbooks()

Dim WB As Workbook

Dim ws As Worksheet
Application.ScreenUpdating = False
Application.DisplayAlerts = False

For Each ws In Worksheets

ws.Copy

Set WB = ActiveWorkbook

WB.SaveAs ThisWorkbook.Path & "\" & ws.Name, FileFormat:=52

WB.Close

Next ws

End Sub

 

[Joe4]

Does it fail on ALL sheets, or just certain ones?

Try showing all alerts initially. Suppressing them can sometimes hide important error information.
Also, let's add a little error handling to see if we can get more information.

Try running this version, and let us know what the message box returns, and let us know if it saved any sheets at all.

Private Sub CreateWorkbooks()

Dim WB As Workbook
Dim ws As Worksheet

'Application.ScreenUpdating = False
Application.DisplayAlerts = True

On Error GoTo err_chk
For Each ws In Worksheets
    ws.Copy
    Set WB = ActiveWorkbook
    WB.SaveAs "H:\balances\" & ws.Name, FileFormat:=52
    WB.Close
Next ws

Exit Sub

err_chk:
    MsgBox Err.Number & ":" & Err.descrtion & vbCrLf & ws.Name
    
End Sub

 

[dmt32]

unfortunately i'm getting the same error. do you think the file could be corrupt?

Hi
untested but see if this update to your code resolves your issue

Private Sub CreateWorkbooks()
    Dim wb          As Workbook
    Dim ws          As Worksheet
    
    Const strFilePath As String = "H:\balances\"
    
    On Error GoTo myerror
    With Application
        .ScreenUpdating = False: .DisplayAlerts = False
    End With
    
    For Each ws In ThisWorkbook.Worksheets
    
        ws.Copy
        Set wb = ActiveWorkbook
        
        wb.SaveAs strFilePath & ws.Name & ".xlsx", FileFormat:=51
        
        wb.Close False
        Set wb = Nothing
        
    Next ws
    
myerror:
    If Not wb Is Nothing Then wb.Close False
    With Application
        .ScreenUpdating = True: .DisplayAlerts = True
    End With
    If Err <> 0 Then MsgBox (Error(Err)), 48, "Error"
End Sub

Dave

 

[rikvny02]

Not sure the reason but I needed to recreate the Original file and Folder. Then the below VBA worked correctly. Thanks to everyone for the help.

Private Sub CreateWorkbooks()

Dim wb As Workbook

Dim ws As Worksheet
Application.ScreenUpdating = False
Application.DisplayAlerts = False

For Each ws In Worksheets

ws.Copy

Set wb = ActiveWorkbook

wb.SaveAs ThisWorkbook.Path & "\" & ws.Name, FileFormat:=52

wb.Close

Next ws

End Sub