Mwspencer
Mwspencer

Reputation: 1183

VBA Save As CSV File is Overwritten by First Sheet

I have workbook, I loop through and save each sheet as a csv. The problem is when the loop finishes Excel prompts me to save. If I click "Save", then last worksheet is overwritten with whichever sheet the excel workbook opens on.

If click "Don't Save" everything remains saved with the proper data, but I can't rely on the user to click "Don't Save" every time so I need to find where my code is over writing the data when saved.

How do I keep my csv sheet from being overwritten?

Sub LipperFormat()

'Create Workbook
Dim wb As Workbook

'Get FilePath
Dim wbActive As Workbook
Set wbActive = ActiveWorkbook
Dim wsActive As Worksheet
Set wsActive = wbActive.Worksheets(1)

'Get File Path
Dim filePath As String
Dim rngActive As Range
Set rngActive = wsActive.Cells(1, 2)
filePath = rngActive.Value

'Open File
Set wb = Workbooks.Open(filePath)

'Create Copy of file and CSV
Dim copyFilePath As String
Dim fileExtension As String: fileExtension = "_OG.xlsx"

copyFilePath = Left(filePath, Len(filePath) - 5) + fileExtension

wb.SaveCopyAs copyFilePath

'Loop through worksheets
Dim WS_Count As Integer
Dim i As Integer

WS_Count = wb.Worksheets.Count

For i = 1 To WS_Count

    Dim col As Integer
    Dim ws As Worksheet
    Set ws = wb.Sheets(i)

    'Save As CSV
    Dim sheetName As String: sheetName = ws.Name
    Dim csvFilePath As String
    Dim csvSheet As Worksheet
    cvsFilePath = Left(filePath, Len(filePath) - 5) + "__" + sheetName

    'ws.Name = sheetName
    ws.SaveAs FileName:=cvsFilePath, FileFormat:=xlCSV, CreateBackup:=False

Next i

'wb.Save
wb.Close

End Sub

Upvotes: 0

Views: 369

Answers (1)

Ibo
Ibo

Reputation: 4319

You code is too large for no benefits. I cleaned it and corrected your mistakes and also added necessary pieces to not ask the users for anything:

Sub LipperFormat()
    Dim filePath As String
    Dim csvFileName As String
    Dim ws As Worksheet
    Dim wb As Workbook

    Application.DisplayAlerts = False

    'define parameters
    Set wb = ThisWorkbook
    Set ws = wb.Worksheets(1) 'it is better to define it with the name, not with its index
    filePath = ws.Cells(1, 2).Value


    'Open File
    Set wb = Workbooks.Open(Filename:=filePath, ReadOnly:=True)

    'loop and save as csv
    For Each ws In wb.Worksheets
        csvFileName = wb.Path & "\" & Left(wb.Name, Len(wb.Name) - 5) & "__" & ws.Name
        ws.Copy
        ActiveWorkbook.SaveAs Filename:=csvFileName, FileFormat:=xlCSV, CreateBackup:=True
        ActiveWorkbook.Close
    Next ws

    'close WB
    wb.Close

    Application.DisplayAlerts = True
End Sub

Upvotes: 2

Related Questions